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Raizes 



• 1980: Flavors - Tl Explorer 

• 1985: NewFlavors - Symbolics 

• 1986: Loops (Lisp Object Oriented Programming System), 
CommonLoops - Xerox Lisp Machines 

• 1986: ObjectLisp- LMI Lambda 

• 1987: Common Objects - HP 



Características 



• Funções Genéricas, Despacho Múltiplo. 

• Classes, Herança Múltipla. 

• Meta -Objectos, Protocolos. 
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Programação Funcional e Imperativa 



(f oo a b) 
(call (function 'foo) a b) 



Programação Orientada a Objectos - Despacho Simples 



(foo a b) O a.foo(b) 
(call (function 'foo (type-of a)) a b) 



Programação Orientada a Objectos - Despacho Múltiplo 



(foo a b) 
(call (function 'foo (type-of a) (type-of b)) a b) 
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Adicionar Entidades 



(defgeneric add (x y) ) 



■aaiBiiKUStH 



Adicionar Entidades 



(defgeneric add (x y) ) 



(def method add ( (x number) (y number) ) 
(+ x y)) 
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Adicionar Entidades 



(defgeneric add (x y) ) 



(def method add ( (x number) (y number) ) 
(+ x y)) 

; ;Testing 
> (add 1 3) 
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Adicionar Entidades 



(defgeneric add (x y) ) 

(def method add ( (x number) (y number) ) 
(+ x y)) 

; ;Testing 
> (add 1 3) 

4 
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Adicionar Entidades 



(defgeneric add (x y) ) 

(def method add ( (x number) (y number) ) 
(+ x y)) 

; ;Testing 

> (add 1 3) 
4 

> (add (vector 1 2) (vector 3 4)) 
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Adicionar Entidades 



(defgeneric add (x y) ) 

(def method add ( (x number) (y number) ) 
(+ x y)) 

; ;Testing 

> (add 1 3) 
4 

> (add (vector 1 2) (vector 3 4)) 

No methods applicable for generic function 

#<STANDARD-GENERIC-FUNCTION ADD> with args (#(1 2) #(3 4)) of classes 
(VECTOR VECTOR) 
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Adicionar Entidades 



(defgeneric add (x y) ) 

(def method add ( (x number) (y number) ) 
(+ x y)) 

; ;Testing 

> (add 1 3) 
4 

> (add (vector 1 2) (vector 3 4)) 

No methods applicable for generic function 

#<STANDARD-GENERIC-FUNCTION ADD> with args (#(1 2) #(3 4)) of classes 
(VECTOR VECTOR) 

(def method add ((x array) (y array) ) 

(assert (equal (array-dimensions x) (array-dimensions y))) 
(let ((z (make-array (array-dimensions x)))) 
(dotimes (i (array-total-size x)) 
(setf (row-major-aref z i) 

(add (row-major-aref x i) (row-major-aref y i)))) 
z)) 
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Adicionar Entidades 



> (add (vector 12 3) (vector 4 5 6)) 



USaS 
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Adicionar Entidades 



> (add (vector 12 3) 
#(5 7 9) 



(vector 4 5 6)) 



USaS 



■aaiBiiKUStH 



Adicionar Entidades 



> (add (vector 12 3) (vector 4 5 6)) 
#(5 7 9) 



> (add (make-array '(2 3) contents '((123) (456))) 

(make-array '(2 3) litial-element 10)) 
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Adicionar Entidades 



> (add (vector 12 3) (vector 4 5 6)) 
#(5 7 9) 



> (add (make-array '(2 3) contents '((123) (456))) 

(make-array '(2 3) litial-element 10)) 

#2A((11 12 13) (14 15 16)) 
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Adicionar Entidades 



> (add (vector 12 3) (vector 4 5 6)) 
#(5 7 9) 

> (add (make-array '(2 3) : contents '((123) (456))) 

(make-array '(2 3) litial-element 10)) 
#2A((11 12 13) (14 15 16)) 

> (add (vector (vector 1 2) 3) 

(vector (vector 3 4) 5)) 



mau 



usa 
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Adicionar Entidades 


> (add (vector 1 2 


3) 


(vect 


or 4 


5 


6)) 










#(5 7 9) 




















> (add (make-array 


'(2 


3) 


initial 


-contente 


'((1 


2 3) 


(4 


5 6))) 


(make-array 


'(2 


3) 


initial 


-element 


10)) 








#2A((11 12 13) (14 


15 


16)) 
















> (add (vector (vec 


tor 


1 2) 


3) 














(vector (vec 


tor 


3 4) 


5)) 














#(#(4 6) 8) 
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Adicionar Entidades 


> (add (vector 


1 2 


3) 


(vect 


or 4 


5 


6)) 










#(5 7 9) 






















> (add (make-array 


'(2 


3) 


initial 


-contente 


'((1 


2 3) 


(4 


5 6))) 


(make-array 


'(2 


3) 


initial 


-element 


10)) 








#2A((11 12 13) 


(14 


15 


16)) 
















> (add (vector 


(vec 


tor 


1 2) 


3) 














(vector 


(vec 


tor 


3 4) 


5)) 














#(#(4 6) 8) 






















> (add (vector 


1 2) 


3) 
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Adicionar Entidades 


> (add (vector 12 3) (vector 4 5 6)) 
#(5 7 9) 




> (add (make-array '(2 3) mtents '((1 2 3) 

(make-array '(2 3) litial-element 10)) 
#2A((11 12 13) (14 15 16)) 


(4 5 6))) 


> (add (vector (vector 1 2) 3) 

(vector (vector 3 4) 5)) 
#(#(4 6) 8) 




> (add (vector 1 2) 3) 

No methods applicable for generic function 
#<STANDARD-GENERIC-FUNCTION ADD> with args (#(1 2) 3) 
(VECTOR FIXNUM) 


of classes 
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Adicionar Entidades 



> (add (vector 12 3) (vector 4 5 6)) 
#(5 7 9) 

> (add (make-array '(2 3) : contents '((123) (456))) 

(make-array '(2 3) litial-element 10)) 
#2A((11 12 13) (14 15 16)) 

> (add (vector (vector 1 2) 3) 

(vector (vector 3 4) 5)) 
#(#(4 6) 8) 

> (add (vector 1 2) 3) 

No methods applicable for generic function 

#<STANDARD-GENERIC-FUNCTION ADD> with args (#(1 2) 3) of classes 
(VECTOR FIXNUM) 



(defmethod add ((x array) (y t)) 
(add x 

(make-array (array-dimensions x) : litial-element y))) 



msm 
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Adicionar Entidades 



> (add (vector 1 2) 3) 



mam 
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Adicionar Entidades 



> (add (vector 1 2) 3) 
#(4 5) 
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Adicionar Entidades 



> (add (vector 1 2) 3) 
#(4 5) 



> (add 1 (make-array '(2 2) litial-contents '((12) (3 4)))) 



Wmmm 
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Adicionar Entidades 



> (add (vector 1 2) 3) 
#(4 5) 



> (add 1 (make-array '(2 2) -contents '((12) (3 4)))) 
No methods applicable for generic function 

#<STANDARD-GENERIC-FUNCTION ADD> with args (1 #2A((1 2) (3 4))) of 
classes (FIXNUM ARRAY) 
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Adicionar Entidades 



> (add (vector 1 2) 3) 
#(4 5) 

> (add 1 (make-array '(2 2) litial-contents '((1 2) (3 4)))) 
No methods applicable for generic function 

#<STANDARD-GENERIC-FUNCTION ADD> with args (1 #2A((1 2) (3 4))) of 
classes (FIXNUM ARRAY) 

(defmethod add ( (x t) (y array) ) 

(add (make-array (array-dimensions y) int x) 

y)) 
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Adicionar Entidades 



> (add (vector 1 2) 3) 
#(4 5) 

> (add 1 (make-array '(2 2) litial-contents '((1 2) (3 4)))) 
No methods applicable for generic function 

#<STANDARD-GENERIC-FUNCTION ADD> with args (1 #2A((1 2) (3 4))) of 
classes (FIXNUM ARRAY) 

(defmethod add ( (x t) (y array) ) 

(add (make-array (array-dimensions y) int x) 

y)) 

> (add 1 (make-array '(2 2) mtents '((12) (3 4)))) 
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Adicionar Entidades 



> (add (vector 1 2) 3) 
#(4 5) 

> (add 1 (make-array '(2 2) litial-contents '((1 2) (3 4)))) 
No methods applicable for generic function 

#<STANDARD-GENERIC-FUNCTION ADD> with args (1 #2A((1 2) (3 4))) of 
classes (FIXNUM ARRAY) 

(defmethod add ( (x t) (y array) ) 

(add (make-array (array-dimensions y) int x) 

y)) 

> (add 1 (make-array '(2 2) mtents '((12) (3 4)))) 
#2A((2 3) (4 5)) 
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Adicionar Entidades 



> (add (vector 1 2) 3) 
#(4 5) 

> (add 1 (make-array '(2 2) litial-contents '((1 2) (3 4)))) 
No methods applicable for generic function 

#<STANDARD-GENERIC-FUNCTION ADD> with args (1 #2A((1 2) (3 4))) of 
classes (FIXNUM ARRAY) 

(defmethod add ( (x t) (y array) ) 

(add (make-array (array-dimensions y) int x) 

y)) 

> (add 1 (make-array '(2 2) mtents '((12) (3 4)))) 
#2A((2 3) (4 5)) 

> (add "12" "34") 
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Adicionar Entidades 



> (add (vector 1 2) 3) 
#(4 5) 

> (add 1 (make-array '(2 2) litial-contents '((1 2) (3 4)))) 
No methods applicable for generic function 

#<STANDARD-GENERIC-FUNCTION ADD> with args (1 #2A((1 2) (3 4))) of 
classes (FIXNUM ARRAY) 

(defmethod add ( (x t) (y array) ) 

(add (make-array (array-dimensions y) :nt x) 

y)) 

> (add 1 (make-array '(2 2) mtents '((12) (3 4)))) 
#2A((2 3) (4 5)) 

> (add "12" "34") 

No methods applicable for generic function 

#<STANDARD-GENERIC-FUNCTION ADD> with args (#\1 #\3) of classes 
(CHARACTER CHARACTER) 
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Adicionar Entidades 



(def method add ( (x string) (y t) ) 
(add (read-f rom-string x) y) ) 

(def method add ((x t) (y string)) 
(add x (read-f rom-string y) ) ) 
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Adicionar Entidades 



(defmethod add ((x string) (y t)) 
(add (read-f rom-string x) y) ) 

(defmethod add ((x t) (y string)) 
(add x (read-f rom-string y) ) ) 

> (add "12" "34") 
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Adicionar Entidades 



(defmethod add ((x string) (y t)) 
(add (read-f rom-string x) y) ) 

(defmethod add ((x t) (y string)) 
(add x (read-f rom-string y) ) ) 

> (add "12" "34") 
46 
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Adicionar Entidades 


(def method add ( (x string 
(add (read-f rom-string 


) (y t)) 
x) y)) 


(defmethod add 
(add x (read- 


((x t) 
from-s 


(y 

triri 


string) ) 

g y))) 


> (add 
46 

> (add 


"12" "34") 
(vector 


"4") 


5) 
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Adicionar Entidades 



(defmethod add ((x string) (y t)) 
(add (read-f rom-string x) y) ) 

(defmethod add ((x t) (y string)) 
(add x (read-f rom-string y) ) ) 

> (add "12" "34") 
46 

> (add (vector 23" "4") 5) 
#(128 9) 
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Adicionar Entidades 


(def method add ( (x string 
(add (read-f rom-string 


) (y t)) 
x) y)) 


(defmethod add 
(add x (read- 


((x t) 
■from-s 


(y 

trir 


string) ) 

g y») 


> (add "12" "34") 
46 

> (add (vector 
#(128 9) 

> (add (vector 12 3) 


'4") 5) 
(list 4 5 6)) 
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Adicionar Entidades 



(defmethod add ((x string) (y t)) 
(add (read-f rom-string x) y) ) 

(defmethod add ( (x t) (y string) ) 
(add x (read-f rom-string y) ) ) 

> (add "12" "34") 
46 

> (add (vector 123" "4") 5) 
#(128 9) 

> (add (vector 12 3) (list 4 5 6)) 

No methods applicable for generic function 
#<STANDARD-GENERIC-FUNCTION ADD> with args 
(FIXNUM CONS) 



(1 (4 5 6)) of classes 
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Adicionar Entidades 



(defmethod add ((x string) (y t)) 
(add (read-f rom-string x) y) ) 

(defmethod add ( (x t) (y string) ) 
(add x (read-f rom-string y) ) ) 

> (add "12" "34") 
46 

> (add (vector 123" "4") 5) 
#(128 9) 

> (add (vector 12 3) (list 4 5 6)) 

No methods applicable for generic function 

#<STANDARD-GENERIC-FUNCTION ADD> with args (1 (4 5 6)) of classes 
(FIXNUM CONS) 

(defmethod add ((x vector) (y list)) 
(add x (coerce y 'vector))) 
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Adicionar Entidades 



(defmethod add ((x string) (y t)) 
(add (read-f rom-string x) y) ) 

(defmethod add ( (x t) (y string) ) 
(add x (read-f rom-string y) ) ) 

> (add "12" "34") 
46 

> (add (vector 123" "4") 5) 
#(128 9) 

> (add (vector 12 3) (list 4 5 6)) 

No methods applicable for generic function 

#<STANDARD-GENERIC-FUNCTION ADD> with args (1 (4 5 6)) of classes 
(FIXNUM CONS) 

(defmethod add ((x vector) (y list)) 
(add x (coerce y 'vector))) 

> (add (vector 12 3) (list 4 5 6)) 
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Adicionar Entidades 



(defmethod add ((x string) (y t)) 
(add (read-f rom-string x) y) ) 

(defmethod add ( (x t) (y string) ) 
(add x (read-f rom-string y) ) ) 

> (add "12" "34") 
46 

> (add (vector 123" "4") 5) 
#(128 9) 

> (add (vector 12 3) (list 4 5 6)) 

No methods applicable for generic function 

#<STANDARD-GENERIC-FUNCTION ADD> with args (1 (4 5 6)) of classes 
(FIXNUM CONS) 

(defmethod add ((x vector) (y list)) 
(add x (coerce y 'vector))) 

> (add (vector 12 3) (list 4 5 6)) 
#(5 7 9) 



Função factorial 
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n\ = 



1 



se n = 



n(n- 1)! se n > 
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Função factorial 



n\ = 



1 se n = 

n(n— 1)! se n > 



Função fact 



(defgeneric fact (n)) 
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Função factorial 



IjBjilBaagia 



n\ = 



1 



se n = 



n(n- 1)! se n > 



Função fact 



(defgeneric fact (n)) 



(defmethod fact ( (n integer)) ;;there is no class for n > 
(* n (fact (1- n)))) 
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Função factorial 



IjBjilBaagia 



n\ = 



1 



se n = 



n(n- 1)! se n > 



Função fact 



(defgeneric fact (n)) 



(defmethod fact ( (n integer)) ;;there is no class for n > 
(* n (fact (1- n)))) 

(defmethod fact ( (n (eql 0))) ;;but we can specialize on 
1) 
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Função factorial 



IjBjilBaagia 



n\ = 



1 



se n = 



n(n- 1)! se n > 



Função fact 



(defgeneric fact (n)) 

(defmethod fact ( (n integer)) ;;there is no class for n > 
(* n (fact (1- n)))) 

(defmethod fact ( (n (eql 0))) ;;but we can specialize on 
1) 

> (fact 5) 
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Função factorial 



IjBjilBaagia 



n\ = 



1 



se n = 



n(n- 1)! se n > 



Função fact 



(defgeneric fact (n)) 

(defmethod fact ( (n integer)) ;;there is no class for n > 
(* n (fact (1- n)))) 

(defmethod fact ( (n (eql 0))) ;;but we can specialize on 
1) 

> (fact 5) 
120 
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Função foobar 



foobar(x) = 



1 se x= 5! 

caso contrário 
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Função foobar 



foobar(x) = 



1 se x= 5! 

caso contrário 



Função foobar 



(defmethod foobar ( (x (eql (fact 5)))) 
D 
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Função foobar 



foobar(x) = 



1 se x= 5! 

caso contrário 



Função foobar 



(defmethod foobar ( (x (eql (fact 5)))) 
D 

(defmethod foobar ( (x t)) 
0) 
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Função foobar 



foobar(x) = 



1 se x= 5! 

caso contrário 



Função foobar 



(defmethod foobar ( (x (eql (fact 5)))) 

(defmethod foobar ( (x t)) 
0) 

> (foobar 34) 
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Função foobar 



foobar(x) = 



1 se x= 5! 

caso contrário 



Função foobar 



(defmethod foobar ( (x (eql (fact 5)))) 

(defmethod foobar ( (x t)) 
0) 

> (foobar 34) 
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Função foobar 



foobar(x) = 



1 se x= 5! 

caso contrário 



Função foobar 



(defmethod foobar ( (x (eql (fact 5)))) 

(defmethod foobar ( (x t)) 
0) 

> (foobar 34) 


> (foobar (fact 5)) 
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Função foobar 



foobar(x) = 



1 se x= 5! 

caso contrário 



Função foobar 



(defmethod foobar ( (x (eql (fact 5)))) 

(defmethod foobar ( (x t)) 
0) 

> (foobar 34) 


> (foobar (fact 5)) 
1 
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Função foobar 



foobar(x) = 



1 se x= 5! 

caso contrário 



Função foobar 



(defmethod foobar ( (x (eql (fact 5)))) 

(defmethod foobar ( (x t)) 
0) 

> (foobar 34) 


> (foobar (fact 5)) 
1 

> (foobar 120) 
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Função foobar 



foobar(x) = 



1 se x= 5! 

caso contrário 



Função foobar 



(defmethod foobar ( (x (eql (fact 5)))) 

(defmethod foobar ( (x t)) 
0) 

> (foobar 34) 


> (foobar (fact 5)) 
1 

> (foobar 120) 
1 
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Função Fibonacci 
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Função Fibonacci 



se n = 0; 

fibín) = < 1 se n= L 

fib(n — 1) + fib(n — 2) caso contrário 



Função f ib 


(defgeneric fib (n 


) 






(defmethod fib 
0) 


((n 


(eql 


0))) 




(defmethod fib 
1) 


((n 


(eql 


1))) 




(defmethod fib 
(+ (fib (- n 


((n 

D) 


number)) 
(fib (- n 


2)))) 



«CTruro 



Exemplo 



> (time (fib 40)) 

; real time 22,612 msec 

102334155 
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Exemplo 



> (time (fib 40)) 

; real time 22,612 msec 

102334155 



Memoization 




mam 



Exemplo 



> (time (fib 40)) 

; real time 22,612 msec 

102334155 



Memoization 



(let ( (cached-results (make-hash-table) ) ) 



msm 



usa 



Exemplo 



> (time (fib 40)) 

; real time 22,612 msec 

102334155 



Memoization 




(let ( (cached-results (make-hash-table) ) ) 
(defmethod fib : i ((n number)) 









msm 



usa 



Exemplo 



> (time (fib 40)) 

; real time 22,612 msec 

102334155 



Memoization 



(let ( (cached-results (make-hash-table) ) ) 
(defmethod fib :arc i ((n number)) 
(or (gethash n cached-results) 



msm 
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Exemplo 



> (time (fib 40)) 

; real time 22,612 msec 

102334155 



Memoization 



(let ( (cached-results (make-hash-table) ) ) 
(defmethod fib :arc i ((n number)) 
(or (gethash n cached-results) 
(setf (gethash n cached-results) 
(call-next-method) ) ) ) ) 



mam 



Exemplo 



> (time (fib 40)) 

; real time 22,612 msec 

102334155 



Memoization 



(let ( (cached-results (make-hash-table) ) ) 
(defmethod fib :arc i ((n number)) 
(or (gethash n cached-results) 
(setf (gethash n cached-results) 
(call-next-method) ) ) ) ) 



Exemplo 



CL-USER> (time (fib 40)) 
; real time 10 msec 
102334155 
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Hierarquia de Tipos Numéricos 




number 



real 



complex 



float 



rational 



/ 



ratio 



\i 



integer 



bignum 
f ixnum 



Função explain 



(defgeneric explain (entity) 

(:metho ((entity f ixnum)) (format t 

(:metho ((entity rational)) (format t 

(:metho ((entity string)) (format t 



entity) ) 
entity)) 
" entity))) 



xsvm™*™ 



uma 
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Hierarquia de Tipos Numéricos 




number 



real 



complex 



float 



rational 



/ 



ratio 



\i 



integer 



bignum 
f ixnum 



Função explain 



(defgeneric explain (entity) 
(:methoi ((entity f ixnum)) 
(:methoi ((entity rational)) 
(:methoi ((entity string)) 

> (explain 123) 



(format t entity)) 

(format t 'ational" entity)) 

(format t " entity))) 
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Hierarquia de Tipos Numéricos 




number 



real 



complex 



float 



rational 



/ 



ratio 



\i 



integer 



bignum 
f ixnum 



Função explain 



(defgeneric explain (entity) 

(:metho ((entity f ixnum)) (format t 

(:metho ((entity rational)) (format t 

(:metho ((entity string)) (format t 

> (explain 123) 
123 is a fixnum 



entity) ) 
entity)) 
" entity))) 



xsvm™*™ 



uma 



iBJliBSmifl 



Hierarquia de Tipos Numéricos 




number 



real 



complex 



float 



rational 



/ 



ratio 



\i 



integer 



bignum 
f ixnum 



Função explain 



(defgeneric explain (entity) 

(:metho ((entity f ixnum)) (format t 

(:metho ((entity rational)) (format t 

(:metho ((entity string)) (format t 

> (explain 123) 
123 is a fixnum 

> (explain "Hi") 



entity) ) 
entity)) 
" entity))) 
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Hierarquia de Tipos Numéricos 




number 



real 



complex 



float 



rational 



/ 



ratio 



\i 



integer 



bignum 
f ixnum 



Função explain 



(defgeneric explain (entity) 

(:metho ((entity f ixnum)) (format t 

(:metho ((entity rational)) (format t 

(:metho ((entity string)) (format t 

> (explain 123) 
123 is a fixnum 

> (explain "Hi") 
"Hi" is a string 



entity) ) 
entity)) 
" entity))) 
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Hierarquia de Tipos Numéricos 




number 



real 



complex 



float 



rational 



/ 



ratio 



\i 



integer 



bignum 
f ixnum 



Função explain 



(defgeneric explain (entity) 

(:metho ((entity f ixnum)) (format t 

(:metho ((entity rational)) (format t 

(:metho ((entity string)) (format t 

> (explain 123) 
123 is a fixnum 

> (explain "Hi") 
"Hi" is a string 

> (explain 1/3) 



entity) ) 
entity)) 
" entity))) 
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Hierarquia de Tipos Numéricos 




number 



real 



complex 



float 



rational 



/ 



ratio 



\i 



integer 



bignum 
f ixnum 



Função explain 



(defgeneric explain (entity) 

(:metho ((entity f ixnum)) (format t 

(:metho ((entity rational)) (format t 

(:metho ((entity string)) (format t 

> (explain 123) 
123 is a fixnum 

> (explain "Hi") 
"Hi" is a string 

> (explain 1/3) 
1/3 is a rational 



entity) ) 
entity)) 
" entity))) 
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Função explain 



(defmethod explain Lfter ((entity integer)) 
(format t entity)) 
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Função explain 



(defmethod explain Lfter ((entity integer)) 
(format t entity)) 



> (explain 123) 
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Função explain 



(defmethod explain LÍter ((entity integer)) 
(format t entity)) 

> (explain 123) 

123 is a fixnum (in binary, is 1111011) 
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Função explain 



(defmethod explain LÍter ((entity integer)) 
(format t entity)) 



> (explain 123) 

123 is a fixnum (in binary, 

> (explain i") 



is 1111011) 
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Função explain 



(defmethod explain Lfter ((entity integer)) 
(format t entity)) 



> (explain 123) 

123 is a fixnum (in binary, 

> (explain ) 

is a string 



is 1111011) 
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Função explain 


(defmethod explain after 
(format t 


((entity integer)) 
is ~B) " entity)) 


> (explain 123) 
123 is a fixnum ( 

> (explain ) 

is a string 

> (explain 1/3) 


m binar j 


, is 1111011) 
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Função explain 



(defmethod explain Lfter ((entity integer)) 
(format t entity)) 

> (explain 123) 

123 is a fixnum (in binary, is 1111011) 

> (explain ;i") 
"Hi" is a string 

> (explain 1/3) 
1/3 is a rational 
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Função explain 



(defmethod explain Lfter ((entity integer)) 
(format t entity)) 

> (explain 123) 

123 is a fixnum (in binary, is 1111011) 

> (explain ;i") 
"Hi" is a string 

> (explain 1/3) 
1/3 is a rational 

(defmethod explain ((entity number)) 
(format t "The r imber )) 
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Função explain 



(defmethod explain Lfter ((entity integer)) 
(format t entity)) 

> (explain 123) 

123 is a fixnum (in binary, is 1111011) 

> (explain ;i") 
"Hi" is a string 

> (explain 1/3) 
1/3 is a rational 

(defmethod explain ((entity number)) 
( f ormat t ) ) 

> (explain 123) 
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Função explain 


(defmethod explain :after 
(format t 


[(entity integer 
entity)) 


)) 


> (explain 123) 

123 is a fixnum (in 

> (explain ) 

is a string 

> (explain 1/3) 
1/3 is a rational 


binar y 


is 1111011) 




(defmethod explain :before 
( f ormat t " ) ' 


((entity number 


)) 


> (explain 
The number 


123) 
123 is a 


fixnum 


(in binary, is 


1111011) 
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Função explain 



(defmethod explain LÍter ((entity integer)) 
(format t entity)) 

> (explain 123) 

123 is a fixnum (in binary, is 1111011) 

> (explain ;i") 
"Hi" is a string 

> (explain 1/3) 
1/3 is a rational 

(defmethod explain ((entity number)) 
(format t iiber )) 

> (explain 123) 

The number 123 is a fixnum (in binary, is 1111011) 

> (explain "Hi") 
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Função explain 



(defmethod explain LÍter ((entity integer)) 
(format t entity)) 

> (explain 123) 

123 is a fixnum (in binary, is 1111011) 

> (explain ;i") 
"Hi" is a string 

> (explain 1/3) 
1/3 is a rational 

(defmethod explain ((entity number)) 
(format t iiber )) 

> (explain 123) 

The number 123 is a fixnum (in binary, is 1111011) 

> (explain "Hi") 
"Hi" is a string 
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Função explain 



(defmethod explain LÍter ((entity integer)) 
(format t entity)) 

> (explain 123) 

123 is a fixnum (in binary, is 1111011) 

> (explain ;i") 
"Hi" is a string 

> (explain 1/3) 
1/3 is a rational 

(defmethod explain ((entity number)) 
(format t iiber )) 

> (explain 123) 

The number 123 is a fixnum (in binary, is 1111011) 

> (explain "Hi") 
"Hi" is a string 

> (explain 1/3) 
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Função explain 


(defmethod explain Lfter ((entity integer 
(format t entity)) 


)) 


> (explain 123) 

123 is a fixnum (in binary 

> (explain "Hi") 
"Hi" is a string 

> (explain 1/3) 
1/3 is a rational 


is 1111011) 




(defmethod explain :before 
( f ormat t " ) ] 


((entity number 


)) 


> (explain 123) 
The number 123 is 

> (explain "Hi") 
"Hi" is a string 

> (explain 1/3) 
The number 1/3 is 


a fixnum (in binary, is 
a rational 


1111011) 
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Aplicação de uma função genérica a argumentos 



O Determinar o método efectivo. 

O Se não existe, invocar a função genérica no-applicable-method 
usando, como argumentos, a função genérica em questão 
juntamente com os seus argumentos. 

O Se existe, invocar o método efectivo com os mesmo argumentos 
da função genérica. 



Determinar o método efectivo 



O Seleccionar os métodos aplicáveis. 

O Ordenar os métodos por precedência, do mais específico para o 
menos específico. 

O Combinar os métodos aplicáveis. 
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Método aplicável 



• Dada uma função genérica e uma lista de argumentos obrigatórios 
ao, ..., a n , um método aplicável é um método dessa função 
genérica cujos especializadores de parâmetros pç,, ..., p n são 
satisfeitos pelos argumentos correspondentes. 

• Um especializador de parâmetro p-, é satisfeito pelo argumento 
correspondente a,- se (typep a,- 'pi). 



Métodos aplicáveis a (explain 123) 




(defmethod explain ((entity fixnum)) 




(format t "~S is a fixnum" entity)) 




(defmethod explain ((entity rational)) 




(format t S is a rational" entity)) 




(defmethod explain :before ((entity number)) 




(format t "The r nber )) 




(defmethod explain ((entity integer)) 




(format t (in binary, is -B) " entity)) 
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Qualificadores 



• Cada método pode ter zero ou mais qualificadores. 

• Um qualificador pode ser qualquer objecto excepto uma lista 
(para distinguir os qualificadores da lista de parâmetros). 

» A combinação standard de métodos distingue: 
Métodos Primários: métodos não-qualificados. 
Métodos Auxiliares: métodos qualificados com os símbolos 
:before, :after e :around. 

• Outras combinações de métodos podem distinguir outros tipos de 
métodos. 

• É possível definir novas combinações de métodos. 
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Métodos primários aplicáveis a (explain 123) 



(defmethod explain ((entity fixnum)) 
(format t entity)) 

(defmethod explain ((entity rational)) 
(format t •ational" entity)) 



Métodos auxiliares aplicáveis a (explain 123) 



(defmethod explain ((entity number)) 

(format t iber ")) 

(defmethod explain Lfter ((entity integer)) 

(format t entity)) 
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Ordenação de Métodos 



Ordena os métodos do mais específico para o menos específico 
comparando-os dois a dois. 
Dados dois métodos aplicáveis: 
O Compara-se os pares de especializadores de parâmetro por ordem 

(por omissão, da esquerda para a direita). 
O Quando os pares de especializadores diferem, o método com maior 
precedência é aquele cujo especializador de parâmetro aparece 
primeiro na lista de precedência de classes do argumento 
correspondente. 
O Se um dos especializadores é de instância ((eql objecto)) então 

esse método tem precedência sobre o outro. 
O Se todos os especializadores são iguais, os qualificadores dos 
métodos são necessariamente diferentes e qualquer dos métodos 
pode ter precedência sobre o outro. 
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Lista de Precedência de Classes de 123 



^^- f loat 
real <T / ratio 

t <^ number <f ^ rational <T 

complex \ integer 



f ixnum, integer, rational, real, number, t 



bignum 
f ixnum 



Ordenação de Métodos aplicáveis a (explain 123) 



(defmethod explain ((entity f ixnum)) 
(format t entity)) 

(defmethod explain Lfter ((entity integer)) 
(format t (in binary, is ~B) " entity)) 

(defmethod explain ((entity rational)) 
(format t entity)) 

(defmethod explain ((entity number)) 
(format t "The imber )) 
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Combinação de Métodos 



• Realizada após a seleccção e ordenação de métodos aplicáveis. 

• Responsável por produzir o método efectivo que vai ser aplicado 
aos argumentos da função genérica. 

• Existem várias formas pré-definidas de combinar os métodos 
(denominados tipos de combinação): 

Simples append, nconc, list, progn, max, min, +, and, or 
Implica especificar o tipo de combinação na função 
genérica e em todos os métodos dessa função. 
Standard standard 

É empregue por omissão se nada for especificado na 
função genérica. Implicitamente usado quando não 
se especifica a função genérica. 
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Combinação Standard de Métodos 



• Os métodos primários definem o comportamento fundamental. 
Apenas o mais específico é executado mas pode executar os 
restantes através de call-next-method. 

• Os métodos auxiliares modificam o comportamento dos métodos 
primários: 

:before Métodos que são executados antes dos métodos 

primários. 
:after Métodos que são executados depois dos métodos 

primários. 
:around Código que é executado no lugar dos métodos 

aplicáveis (incluindo os métodos primários e outros 

métodos auxiliares) mas que os pode executar 

através de call-next-method. 
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Combinação Standard de Métodos 



Se não existem métodos : around: 

O Todos os métodos :before são executados, do mais específico 

para o menos específico, ignorando-se os seus valores. 
O método primário mais específico é executado. 

• Se esse método invoca call-next-method, o próximo método 
mais específico é executado e os seus valores são devolvidos ao 
método que invocou call-next-method. 

• Os valores devolvidos pelo método primário mais específico são os 
valores devolvidos pela invocação da função genérica. 

O Todos os métodos :after são executados, do menos específico 
para o mais específico, ignorando-se os seus valores. 
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Combinação Standard de Métodos 



Se existem métodos :around, o mais específico é executado. Se esse 
método invoca call-next-method: 

O Se existir, o próximo método :around mais específico é 

executado e os seus valores são devolvidos ao método que invocou 
call-next-method. 
O Se não existir outro método :around: 

O Todos os métodos :before são executados, do mais específico 

para o menos específico, ignorando-se os seus valores. 
O O método primário mais específico é executado. Se esse método 
invoca call-next-method, o próximo método mais específico é 
executado e os seus valores são devolvidos ao método que invocou 
call-next-method. 
O Todos os métodos :after são executados, do menos específico 
para o mais específico, ignorando-se os seus valores. 
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Combinação Standard de Métodos 



A invocação da função call-next-method pode ser feita: 

• Sem argumentos: implica usar os mesmos argumentos que foram 
usados na invocação do método. 

• Com argumentos: usa novos argumentos mas os novos argumentos 
devem implicar a mesma sequência ordenada de métodos aplicáveis 
que foi usada para os argumentos originais. 

Se, quando se invoca a função call-next-method, não existir 
mais nenhum método aplicável, é invocada automaticamente a 
função genérica no-next-method usando, como argumentos: 

• A função genérica a que pertence o método que invocou 
call-next-method. 

• O método que invocou call-next-method. 

• Os argumentos que foram passados ao call-next-method. 

A função next-method-p testa se existe mais algum método. 
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Métodos aplicáveis a (explain 123) segundo a combinação 


standard 






(defmethod 
(format t 


explain before ((entity number)) 
"The number )) 


(defmethod 
(format t 


explain 
"~S is 


((entity fixnum)) 
a fixnum" entity)) 


(defmethod 
(format t 


explain 
"~S is 


((entity rational)) 
a rational" entity)) 


(defmethod 
(format t 


explain ((entity integer)) 

entity)) 



Método Efectivo aplicado a (explain 123) (simplificado) 



(lambda (entity) 

(format t ") 

(format t entity) 

(format t (in binary, is -B) " entity)) 
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Combinação Simples de Métodos 



A combinação simples de métodos distingue: 

Métodos Primários: métodos qualificados com o tipo de combinação 
(append, nconc, list, progn, max, min, +, and, or). 

Métodos Auxiliares: métodos qualificados com o símbolo :around. 

Se não existem métodos : around: 

O método efectivo é construído combinando o operador indicado 
pelo tipo de combinação com as invocações de todos os métodos 
primários pela sua ordem de especificidade (ou pela ordem 
inversa, se tal for indicado na função genérica). 
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Combinação Simples de Métodos 



Se existem métodos :around, o mais específico é executado. Se esse 
método invoca call-next-method: 

O Se existir, o próximo método :around mais específico é 

executado e os seus valores são devolvidos ao método que invocou 
call-next-method. 
O Se não existir outro método :around: 

O método efectivo é construído combinando o operador indicado 
pelo tipo de combinação com as invocações de todos os métodos 
primários pela sua ordem de especificidade (ou pela ordem inversa, 
se tal for indicado na função genérica). 
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Combinação Simples de Métodos 



(defgeneric what-are-you? (obj) 

( :method-combinatio list :most-specif ic-last) ) 



mau 



oãm 



■aaiBiiKUStH 



Combinação Simples de Métodos 



(defgeneric what-are-you? (obj) 

( :method-combinatio list :most-specif ic-last) ) 

(defmethod what-are-you? list ((obj fixnum)) 
I am a FIXNUM") 

(defmethod what-are-you? list ((obj float)) 
I am a FLOAT") 

(defmethod what-are-you? list ((obj number)) 
"I am a NUMBER") 
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Combinação Simples de Métodos 



(defgeneric what-are-you? (obj) 

( :method-combinatio list :most-specif ic-last) ) 

(defmethod what-are-you? list ((obj fixnum)) 
I am a FIXNUM") 

(defmethod what-are-you? list ((obj float)) 
I am a FLOAT") 

(defmethod what-are-you? list ((obj number)) 
I am a NUMBER") 

> (what-are-you? 123) 
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Combinação Simples de Métodos 



(defgeneric what-are-you? (obj) 

( :method-combinatio list :most-specif ic-last) ) 

(defmethod what-are-you? list ((obj fixnum)) 
I am a FIXNUM") 

(defmethod what-are-you? list ((obj float)) 
I am a FLOAT") 

(defmethod what-are-you? list ((obj number)) 
I am a NUMBER") 

> (what-are-you? 123) 

("I am a NUMBER" "I am a FIXNUM") 
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Combinação Simples de Métodos 



(defgeneric what-are-you? (obj) 

( :method-combinatio list :most-specif ic-last) ) 

(defmethod what-are-you? list ((obj fixnum)) 
I am a FIXNUM") 

(defmethod what-are-you? list ((obj float)) 
I am a FLOAT") 

(defmethod what-are-you? list ((obj number)) 
I am a NUMBER") 

> (what-are-you? 123) 

("I am a NUMBER" "I am a FIXNUM") 

> (what-are-you? 1.23) 
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Combinação Simples de Métodos 



(defgeneric what-are-you? (obj) 

( :method-combinatio list :most-specif ic-last) ) 

(defmethod what-are-you? list ((obj fixnum)) 
I am a FIXNUM") 

(defmethod what-are-you? list ((obj float)) 
I am a FLOAT") 

(defmethod what-are-you? list ((obj number)) 
I am a NUMBER") 

> (what-are-you? 123) 

("I am a NUMBER" "I am a FIXNUM") 

> (what-are-you? 1.23) 

("I am a NUMBER" "I am a FLOAT") 

> (what-are-you? 1/3) 
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Combinação Simples de Métodos 



(defgeneric what-are-you? (obj) 

( :method-combinatio list :most-specif ic-last) ) 

(defmethod what-are-you? list ((obj fixnum)) 
I am a FIXNUM") 

(defmethod what-are-you? list ((obj float)) 
I am a FLOAT") 

(defmethod what-are-you? list ((obj number)) 
I am a NUMBER") 

> (what-are-you? 123) 

("I am a NUMBER" "I am a FIXNUM") 

> (what-are-you? 1.23) 

("I am a NUMBER" "I am a FLOAT") 

> (what-are-you? 1/3) 
("I am a NUMBER") 
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Combinação Simples de Métodos 



(defmethod what-are-you? list ((obj ratio)) 
"I am a RATIO") 
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Combinação Simples de Métodos 



(defmethod what-are-you? list ((obj ratio)) 
I am a RATIO") 

> (what-are-you? 123) 
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Combinação Simples de Métodos 



(defmethod what-are-you? list ((obj ratio)) 
I am a RATIO") 

> (what-are-you? 123) 

("I am a NUMBER" "I am a FIXNUM") 
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Combinação Simples de Métodos 



(defmethod what-are-you? list ((obj ratio)) 
I am a RATIO") 

> (what-are-you? 123) 

("I am a NUMBER" "I am a FIXNUM") 

> (what-are-you? 1.23) 
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Combinação Simples de Métodos 



(defmethod what-are-you? list ((obj ratio)) 
I am a RATIO") 

> (what-are-you? 123) 

("I am a NUMBER" "I am a FIXNUM") 

> (what-are-you? 1.23) 

("I am a NUMBER" "I am a FLOAT") 
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Combinação Simples de Métodos 



(defmethod what-are-you? list ((obj ratio)) 
I am a RATIO") 

> (what-are-you? 123) 

("I am a NUMBER" "I am a FIXNUM") 

> (what-are-you? 1.23) 

("I am a NUMBER" "I am a FLOAT") 

> (what-are-you? 1/3) 
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Combinação Simples de Métodos 


(defmethod what-< 


ire-you? list ((obj 


ratio) ) 


"I am a RATIO" 








> (what-are-you? 


123) 






("I am a NUMBER" 


"I am 


a FIXNUM") 




> (what-are-you? 


1.23) 






("I am a NUMBER" 


"I am 


a FLOAT") 




> (what-are-you? 


1/3) 






("I am a NUMBER" 


"I am 


D") 





mau 



oãm 



■aaiBiiKUStH 



Combinação Simples de Métodos 


(defmethod what-are-you? list ((obj 


ratio) ) 


I am a RATIO") 




> (what-are-you? 123) 




("I am a NUMBER" "I am a FIXNUM") 




> (what-are-you? 1.23) 




("I am a NUMBER" "I am a FLOAT") 




> (what-are-you? 1/3) 




("I am a NUMBER" "I am a RATIO") 




(defmethod what-are-you? list ((obj 


(eql 1))) 


THE SPECIAL ONE") 
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Combinação Simples de Métodos 



(defmethod what-are-you? list ((obj ratio)) 
I am a RATIO") 

> (what-are-you? 123) 

("I am a NUMBER" "I am a FIXNUM") 

> (what-are-you? 1.23) 

("I am a NUMBER" "I am a FLOAT") 

> (what-are-you? 1/3) 

("I am a NUMBER" "I am a RATIO") 

(defmethod what-are-you? list ((obj (eql 1))) 
THE SPECIAL ONE") 

> (what-are-you? 0) 
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Combinação Simples de Métodos 



(defmethod what-are-you? list ((obj ratio)) 
I am a RATIO") 

> (what-are-you? 123) 

("I am a NUMBER" "I am a FIXNUM") 

> (what-are-you? 1.23) 

("I am a NUMBER" "I am a FLOAT") 

> (what-are-you? 1/3) 

("I am a NUMBER" "I am a RATIO") 

(defmethod what-are-you? list ((obj (eql 1))) 
THE SPECIAL ONE") 

> (what-are-you? 0) 

("I am a NUMBER" "I am a FIXNUM") 
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Combinação Simples de Métodos 



(defmethod what-are-you? list ((obj ratio)) 
"I am a RATIO") 

> (what-are-you? 123) 

("I am a NUMBER" "I am a FIXNUM") 

> (what-are-you? 1.23) 

("I am a NUMBER" "I am a FLOAT") 

> (what-are-you? 1/3) 

("I am a NUMBER" "I am a RATIO") 

(defmethod what-are-you? list ((obj (eql 1))) 
THE SPECIAL ONE") 

> (what-are-you? 0) 

("I am a NUMBER" "I am a FIXNUM") 

> (what-are-you? 1) 

("I am a NUMBER" "I am a FIXNUM" "I am THE SPECIAL ONE") 



mau 
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Combinação Simples de Métodos 



(defmethod what-are-you? list ((obj null)) 
I am a NULL") 

(defmethod what-are-you? list ((obj symbol)) 
I am a SYMBOL") 

(defmethod what-are-you? list ((obj list)) 
"I am a LIST") 
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Combinação Simples de Métodos 



(defmethod what-are-you? list ((obj null)) 
I am a NULL") 

(defmethod what-are-you? list ((obj symbol)) 
I am a SYMBOL") 

(defmethod what-are-you? list ((obj list)) 
"I am a LIST") 

> (what-are-you? 'hi) 
("I am a SYMBOL") 
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Combinação Simples de Métodos 


(defmethod what-are-you? list ((obj 
I am a NULL") 


null)) 


(defmethod what-are-you? list ((obj 
I am a SYMBOL") 


symbol) ) 


(defmethod what-are-you? list ((obj 
"I am a LIST") 


list)) 


> (what-are-you? 'hi) 
("I am a SYMBOL") 




> (what-are-you? '(1 2 3)) 
("I am a LIST") 
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Combinação Simples de Métodos 


(defmethod what-are-you? list 
I am a NULL") 


(Cobj 


null)) 


(defmethod what-are-you? list 
I am a SYMBOL") 


(Cobj 


symbol) ) 


(defmethod what-are-you? list 
"I am a LIST") 


(Cobj 


list)) 


> (what-are-you? 'hi) 
("I am a SYMBOL") 






> (what-are-you? '(1 2 3)) 
("I am a LIST") 






> (what-are-you? '()) 

("I am a LIST" "I am a SYMBOL 


I am a NULL") 
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Combinação de Métodos definida pelo utilizador 



(def ine-method-combination list () 
((methods (list))) 
"(list , @(mapcar #' (lambda (method) 

~ (call-method , method)) 
methods)) ) 



Definição 
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Combinação de Métodos definida pelo utilizador 



(def ine-method-combination list () 
((methods (list))) 
"(list , @(mapcar #' (lambda (method) 

~ (call-method , method)) 
methods)) ) 



Definição 
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Combinação de Métodos definida pelo utilizador 



(def ine-method-combination list () 
((methods (list))) 
"(list , @(mapcar #' (lambda (method) 

~ (call-method , method)) 
methods)) ) 



Definição 



• Nome da combinação de método. 

• Parâmetros da combinação de método (por exemplo, a ordenação 
dos métodos). 
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Combinação de Métodos definida pelo utilizador 



(def ine-method-combination list () 
((methods (list))) 
"(list , @(mapcar #' (lambda (method) 

~ (call-method , method)) 
methods)) ) 



Definição 



• Nome da combinação de método. 

• Parâmetros da combinação de método (por exemplo, a ordenação 
dos métodos). 

• Variável local para conter os métodos cujos qualificadores... 
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Combinação de Métodos definida pelo utilizador 



(def ine-method-combination list () 
((methods (list))) 
"(list , @(mapcar #' (lambda (method) 

~ (call-method , method)) 
methods)) ) 



Definição 


• 


Nome da combinação de método. 










• 


Parâmetros da combinação de métodc 
dos métodos). 


» (por 


exemplo, 


a ord 


enação 


• 


Variável local para conter os métodos 


cujos qualificac 


ores... 




• 


...satisfazem este padrão 
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Combinação de Métodos definida pelo utilizador 



(def ine-method-combination list () 
((methods (list))) 
"(list , @(mapcar #' (lambda (method) 

~ (call-method ,method)) 
methods)) ) 



Definição 


• 


Nome da combinação de método. 










• 


Parâmetros da combinação de método 


(por exemplo, 


a ord 


enacão 




dos métodos). 










• 


Variável local para conter os métodos 


cujos qua 


lificac 


ores... 




• 


...satisfazem este padrão 










• 


Invocação de cada método no método 


efectivo 
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Combinação Standard de Métodos 



(def ine-method-combination standard () 

((around ( xround)) 

(before (:before)) 

(primary () :required t) 

(after (:after))) 

(flet ((call-methods (methods) 

(mapcar #' (lambda (method) 

" (call-method , method)) 
methods)) ) 
(let ((form (if (or before after (rest primary)) 
' (multiple-value-progl 

(progn , @(call-methods before) 

(call-method , (f irst primary) 
, (rest primary))) 
, (call-methods (reverse after))) 
"(call-method , (f irst primary))))) 
(if around 

~ (call-method , (f irst around) 
(,@(rest around) 
(make-method ,form))) 



form)))) 
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Definição de classes com defclass 



(defclass foo (bar baz) 

((slotl : (fact 5) 
:reader foo-slotl 
:writer set-f oo-slotl) 
(slot2 :type string 
: initarg :slot2 
:accessor foo-slot2) 
(slot3 : ai] class)) 
( :def ault-initargs : slot2 "hi there")) 
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Definição de classes com defclass 



(defclass f d (bar baz) 

((slotl (fact 5) 

:reader foo-slotl 
:writer set-f oo-slotl) 
(slot2 :type string 
: initarg :slot2 
:accessor foo-slot2) 
(slot3 : ai] class)) 
( :def ault-initargs : slot2 "hi there")) 
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Definição de classes com defclass 



(defclass foo (bar baz) 

((slotl : (fact 5) 
:reader foo-slotl 
:writer set-f oo-slotl) 
(slot2 :type string 
: initarg :slot2 
:accessor foo-slot2) 
(slot3 : ai] class)) 
( :def ault-initargs : slot2 "hi there")) 
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Definição de classes com defclass 



(defclass foo (bar baz) 

((slotl (fact 5) 

:reader foo-slotl 
:writer set-f oo-slotl) 
(slot2 :type string 
: initarg :slot2 
:accessor foo-slot2) 
(slot3 : ai] class)) 
( :def ault-initargs : slot2 "hi there")) 
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Definição de classes com defclass 



(defclass foo (bar baz) 

((slotl (fact 5) 

f oo-slotl 
:writer set-f oo-slotl) 
(slot2 :type string 
: initarg :slot2 
:accessor foo-slot2) 
(slot3 : ai] class)) 
( :def ault-initargs : slot2 "hi there")) 
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Definição de classes com defclass 



(defclass foo (bar baz) 

((slotl (fact 5) 

f oo-slotl 
r set-f oo-slotl) 
(slot2 :type string 
: initarg :slot2 
:accessor foo-slot2) 
(slot3 class)) 

( :def ault-initargs : slot2 "hi there")) 

(defmethod f oo-slotl ((obj foo)) 
(slot-value obj 'slotl)) 
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Definição de classes com defclass 



(defclass foo (bar baz) 

((slotl : (fact 5) 
:reade: foo-slotl 

set-f oo-slotl) 
(slot2 :type string 
: initarg :slot2 
:accessor foo-slot2) 
(slot3 class)) 

( :def ault-initargs : slot2 "hi there ) ) 

(defmethod foo-slotl ((obj foo)) 
(slot-value obj 'slotl)) 

(defmethod set-f oo-slotl ((obj foo) new-value) 
(setf (slot-value obj 'slotl) new-value)) 
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Definição de classes com defclass 



(defclass foo (bar baz) 

((slotl : (fact 5) 
:reader foo-slotl 

r set-f oo-slotl) 
(slot2 string 
: initarg :slot2 
:accessor foo-slot2) 
(slot3 : ai] class)) 
( :def ault-initargs : slot2 "hi there ) ) 

(defmethod foo-slotl ((obj foo)) 
(slot-value obj 'slotl)) 

(defmethod set-f oo-slotl ((obj foo) new-value) 
(setf (slot-value obj 'slotl) new-value)) 
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Definição de classes com defclass 



(defclass foo (bar baz) 

((slotl : (fact 5) 
:reader foo-slotl 

•iter set-f oo-slotl) 
(slot2 string 



r foo-slot2) 
(slot3 : ai] class)) 
( :def ault-initargs : slot2 "hi there ) ) 

(defmethod foo-slotl ((obj foo)) 
(slot-value obj 'slotl)) 

(defmethod set-f oo-slotl ((obj foo) new-value) 
(setf (slot-value obj 'slotl) new-value)) 
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Definição de classes com defclass 



(defclass foo (bar baz) 

((slotl :initform (fact 5) 
:reader foo-slotl 
:writer set-f oo-slotl) 
(slot2 :type string 
: initarg :slot2 
^^^B foo-slot2) 
(slot3 class)) 

( :def ault-initargs : slot2 "hi there ) ) 

(defmethod foo-slotl ((obj foo)) 
(slot-value obj 'slotl)) 

(defmethod set-f oo-slotl ((obj foo) new-value) 
(setf (slot-value obj 'slotl) new-value)) 

(defmethod foo-slot2 ((obj foo)) 
(slot-value obj 'slot2)) 

(defmethod (setf foo-slot2) (new-value (obj foo)) 
(setf (slot-value obj 'slot2) new-value)) 
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Definição de classes com defclass 



(defclass foo (bar baz) 

((slotl :initform (fact 5) 
:reader foo-slotl 
:writer set-f oo-slotl) 
(slot2 :type string 
: initarg :slot2 
:accesso: foo-slot2) 
(slot3 | )) 

( :def ault-initargs : slot2 "hi there')) 

(defmethod foo-slotl ((obj foo)) 
(slot-value obj 'slotl)) 

(defmethod set-f oo-slotl ((obj foo) new-value) 
(setf (slot-value obj 'slotl) new-value)) 

(defmethod foo-slot2 ((obj foo)) 
(slot-value obj 'slot2)) 

(defmethod (setf foo-slot2) (new-value (obj foo)) 
(setf (slot-value obj 'slot2) new-value)) 
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Definição de classes com defclass 



(defclass foo (bar baz) 

((slotl :initform (fact 5) 
:reader foo-slotl 
:writer set-f oo-slotl) 
(slot2 :type string 
: initarg :slot2 
:accessoi. foo-slot2) 
(slot3 class)) 

(defmethod foo-slotl ((obj foo)) 
(slot-value obj 'slotl)) 

(defmethod set-f oo-slotl ((obj foo) new-value) 
(setf (slot-value obj 'slotl) new-value)) 

(defmethod foo-slot2 ((obj foo)) 
(slot-value obj 'slot2)) 

(defmethod (setf foo-slot2) (new-value (obj foo)) 
(setf (slot-value obj 'slot2) new-value)) 
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HHÉiaSSIS 



Classes 



(defclass shape () 
O) 

(defclass device () 
O) 
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HHÉiaSSIS 



ystem 



Classes 



(defclass shape () 
O) 

(defclass device () 
O) 

(defgeneric draw (shape device)) 

(defmethod draw ((s shape) (d device)) 
(format t "draw what where?-"/")) 
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HHÉiaSSIS 



ystem 



Classes 



(defclass shape () 
O) 

(defclass device () 
O) 

(defgeneric draw (shape device)) 

(defmethod draw ((s shape) (d device)) 
(format t "draw what where?~°/,")) 

(defclass line (shape) 
O) 

(defclass circle (shape) 
O) 



^reiat^m? 



HHÉiaSSIS 



ystem 



Classes 



(defclass shape () 
O) 

(defclass device () 
O) 

(defgeneric draw (shape device)) 

(defmethod draw ((s shape) (d device)) 
(format t "draw what where?~°/,")) 

(defclass line (shape) 
O) 

(defclass circle (shape) 
O) 

(defclass screen (device) 
O) 

(defclass printer (device) 
O) 
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wuijiassis 



.t System 



Despacho Múltiplo 



(defmethod draw ((s line) (d device)) 

(format t draw a line where?~°/,' ) ) 

(defmethod draw ((s circle) (d device)) 

(format t "draw a circle where?~°/„") ) 



msm 



oãm 



wuijiassis 



.t System 



Despacho Múltiplo 



(defmethod draw ((s line) (d device)) 
(format t draw a line where?~°/,' ) ) 

(defmethod draw ((s circle) (d device)) 
(format t "draw a circle where?~y o " ) ) 

(defmethod draw ((s shape) (d screen)) 
(format t "draw what on screen?-"/")) 

(defmethod draw ((s shape) (d printer)) 
(format t iraw what on printer?-"/")) 
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.t System 



Despacho Múltiplo 



(defmethod draw ((s line) (d screen)) 

(format t "drawing a line on screen!-'/,")) 

(defmethod draw ((s circle) (d screen)) 

(format t "drawing a circle on screen! -%")) 

(defmethod draw ((s line) (d printer)) 

(format t "drawing a line cri printer ! ~°/") ) 

(defmethod draw ((s circle) (d printer)) 

(format t "drawin n printer ! ~°/„") ) 
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.t System 



Despacho Múltiplo 



(let ((shapes (list (make-instance 'line) 

(make-instance 'circle))) 
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.t System 



Despacho Múltiplo 



(let ((shapes (list (make-instance 'line) 

(make-instance 'circle))) 
(devices (list (make-instance ' screen) 

(make-instance 'printer) )) ) 
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.t System 



Despacho Múltiplo 



(let ((shapes (list (make-instance 'line) 

(make-instance 'circle))) 
(devices (list (make-instance ' screen) 

(make-instance 'printer) )) ) 
(dolist (device devices) 
(dolist (shape shapes) 
(draw shape device)))) 
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.t System 



Despacho Múltiplo 


(let ((shapes (list (make-instance 


line) 


(make-instance 


circle) )) 


(devices (list (make-instance 


' screen) 


(make-instance 


'printer) )) ) 


(dolist (device devices) 




(dolist (shape shapes) 




(draw shape device)))) 




drawing a line on screen! 




drawing a circle on screen! 




drawing a line on pr inter! 




drawing a circle on printer! 
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.t System 



(defclass 2d-position () 
((x :x) 

(y -y))) 
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(defclass 2d-position () 
((x :initarg :x) 
(y :y))) 

(defclass line (shape) 

((origin : initarg : origin :accessor line-origin) 
(end : initarg :end :accessor line-end))) 

(defclass circle (shape) 

((center : initarg :center :accessor circle-center) 
(radius :radius :accessor circle-radius 1))) 
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(defclass 2d-position () 
((x :initarg :x) 
(y :y))) 

(defclass line (shape) 

((origin : initarg : origin :accessor line-origin) 
(end : initarg :end :accessor line-end))) 

(defclass circle (shape) 

((center : initarg :center :accessor circle-center) 
(radius initarg :radius :accessor circle-radius :initform 1))) 



> (make-instance 'circle 

inter (make-instance '2d-position 
: radius 5) 



10 



30) 
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(defclass 2d-position () 
((x :initarg :x) 
(y :y))) 

(defclass line (shape) 

((origin : initarg : origin :accessor line-origin) 
(end : initarg :end :accessor line-end))) 

(defclass circle (shape) 

((center : initarg :center :accessor circle-center) 
(radius initarg :radius :accessor circle-radius :initform 1))) 



> (make-instance 'circle 

inter (make-instance '2d-position 
: radius 5) 
#<CIRCLE #x71641cla> 



10 



30) 
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(defclass 2d-position () 
((x :initarg :x) 
(y :y))) 

(defclass line (shape) 

((origin : initarg : origin :accessor line-origin) 
(end : initarg :end :accessor line-end))) 

(defclass circle (shape) 

((center : initarg :center :accessor circle-center) 
(radius initarg :radius :accessor circle-radius :initform 1))) 



> (make-instance 'circle 

inter (make-instance '2d-position : 10 
: radius 5) 
#<CIRCLE @ #x71641cla> 



30) 



> (circle-radius (make-instance 'circle)) 
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(defclass 2d-position () 
((x :initarg :x) 
(y :y))) 

(defclass line (shape) 

((origin : initarg : origin :accessor line-origin) 
(end : initarg :end :accessor line-end))) 

(defclass circle (shape) 

((center : initarg :center :accessor circle-center) 
(radius initarg :radius :accessor circle-radius :initform 1))) 



> (make-instance 'circle 

inter (make-instance '2d-position : 10 
: radius 5) 
#<CIRCLE @ #x71641cla> 



30) 



> (circle-radius (make-instance 'circle)) 
1 
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.t System 



Mixins 


(defclass color-mixin () 




((color : initarg 


: accessor color) ) ) 
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.t System 



Mixins 



(defclass color-mixin () 

((color : initarg : color :accessor color))) 

(defmethod draw :arc ((s color-mixin) (d device)) 
(let ( (previous-color (color d))) 
(setf (color d) (color s)) 
(unwind-protect 

(call-next-method) 
(setf (color d) previous-color)))) 
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.t System 



Mixins 



(defclass color-mixin () 

((color : initarg : color :accessor color))) 

(defmethod draw :arc ((s color-mixin) (d device)) 
(let ( (previous-color (color d))) 
(setf (color d) (color s)) 
(unwind-protect 

( c ai 1 -next -method) 
(setf (color d) previous-color)))) 

(defclass colored-line (color-mixin line) 
O) 

(defclass colored-circle (color-mixin circle) 
O) 
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.t System 



Mixins 



(defclass colored-printer (printer) 

((ink : ínitf o black :accessor color))) 

(defmethod (setf color) >re (color (d colored-printer)) 
(format t "changing printer ink color to ~A~°/„" color)) 
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.t System 



Mixins 



(defclass colored-printer (printer) 

((ink : initf orm :black :accessor color))) 

(defmethod (setf color) (color (d colored-printer)) 
(format t "changing printer ink color to ~A~°/„" color)) 

(let ((shapes (list (make-instance 'line) 

(make-instance ' colored-circle ed) 

(make-instance ' colored-line lie))) 

(printer (make-instance 'colored-printer))) 
(dolist (shape shapes) 
(draw shape printer) ) ) 
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.t System 



Mixins 



(defclass colored-printer (printer) 

((ink : initf orm :black :accessor color))) 

(defmethod (setf color) (color (d colored-printer)) 
(format t "changing printer ink color to ~A~°/„" color)) 

(let ((shapes (list (make-instance 'line) 

(make-instance ' colored-circle ed) 

(make-instance ' colored-line lie))) 

(printer (make-instance 'colored-printer))) 
(dolist (shape shapes) 
(draw shape printer) ) ) 

drawing a line on printer! 
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Mixins 



(defclass colored-printer (printer) 

((ink : initf orm :black :accessor color))) 

(defmethod (setf color) (color (d colored-printer)) 
(format t "changing printer ink color to ~A~°/„" color)) 

(let ((shapes (list (make-instance 'line) 

(make-instance ' colored-circle ed) 

(make-instance ' colored-line lie))) 

(printer (make-instance 'colored-printer))) 
(dolist (shape shapes) 
(draw shape printer) ) ) 






drawing a line on printer! 
changing printer ink color to RED 
drawing a circle on printer! 
changing printer ink color to BLACK 
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.t System 



Mixins 



(defclass colored-printer (printer) 

((ink : initf orm :black :accessor color))) 

(defmethod (setf color) (color (d colored-printer)) 
(format t "changing printer ink color to ~A~°/„" color)) 

(let ((shapes (list (make-instance 'line) 

(make-instance ' colored-circle ed) 

(make-instance ' colored-line lie))) 

(printer (make-instance 'colored-printer))) 
(dolist (shape shapes) 
(draw shape printer) ) ) 






drawing a line on printer! 
changing printer ink color to RED 
drawing a circle on printer! 
changing printer ink color to BLACK 
changing printer ink color to BLUE 
drawing a line on printer! 
changing printer ink color to BLACK 
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Herança de Classes 



• A classe C\ é uma subclasse directa da classe C2 (a classe C2 é 
uma superclasse directa da classe C\) se C\, na sua definição, 
explicitamente designa C2 na lista de superclasses. 

• A classe C\ é uma subclasse da classe C n (a classe C n é uma 
superclasse da classe Ci) se existir uma sequência de classes 
C2, . . . , C„_i tais que C,- é uma subclasse directa de C /+ i, 

< /" < n. 

• A lista de precedências da classe Cé uma ordenação total do 
conjunto contendo Ce todas as suas superclasses, da mais 
específica para a menos específica. 

• A ordenação da lista de precedências da classe C é consistente 
com a ordenação local de superclasses directas presente na 
definição de C. 
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Lista de Precedências de Classes 



Flavors Profundidade primeiro, da esquerda para a direita, sem 
os últimos duplicados (standard-object e t 
adicionados no fim). 

Loops Idêntica mas sem os primeiros duplicados. 

CLOS Ordenação topológica do grafo de classes tendo em 
conta a ordenação local de superclasses. 



Exemplo de Hierarquia de Classes 



(def class 


a 





0) 


(def class 


b 





0) 


(def class 


c 





0) 


(def class 


d 


(a 


b) ()) 


(def class 


e 


(a 


c) 0) 


(def class 


f 


(d 


e) 0) 
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Lista de Precedências da Classe f 


Flavors 


(f d a 


b e c standard- 


-object 


t) 


Loops 


(f d b 


e a c standard- 


-object 


t) 


CLOS 


(f d e 


a c b standard- 


-object 


t) 



msm 



oãm 



IjBjilBaagia 



MetaClasses 


• 


As classes são representadas 


por objectos que são 


instâncias de 




classes. 








• 


A metaclasse de 


um objecte 


é a classe da classe 


desse objecto. 


• 


Uma metaclasse 


é uma classe cujas instâncias são classes. 



Responsabilidades 


• A metaclasse determina 


a 


forma de h 


erança 


das classes que 


são 


suas instâncias. 












• A metaclasse determina 


a 


representação das 


instâncias das 


classes 


que são suas instâncias. 












• A metaclasse determina 


o 


acesso aos 


slots d 


as instâncias. 





«HaBi 
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Hierarquia de Classes 



standard-object 





standard- cias s 

f orward-ref erenced-class 

built-in-class 



method- combinat ion 
generic-function 



Definição 



• A classe t não tem superclasse e é superclasse de todas as classes 
menos dela própria. 

• A classe standard-object é subclasse directa da classe t, é uma 
instância da classe standard-class e é superclasse de todas as 
classes que são instâncias de standard-class menos dela 
própria. 



EEMim 
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A Metaclasse standard-class 



> (defclass foo () ()) 



;A 'normal' class 



iEgHfllEB 
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A Metaclasse standard-class 



> (defclass foo () ()) 
#<STANDARD-CLASS FOO 



;A 'normal' class 



msm 



usa 
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A Metaclasse standard-class 



> (defclass foo () ()) 
#<STANDARD-CLASS FOO 

> (make-instance 'foo) 



;A 'normal' class 
;A 'normal' instance 



msm 
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A Metaclasse standard-class 



> (defclass foo () ()) 
#<STANDARD-CLASS FOO 

> (make-instance 'foo) 
#<F00 @ #x717910a2> 



;A 'normal' class 

;A 'normal' instance 
;Note #<CLASS INSTANCE> 



msm 
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A Metaclasse standard-class 



> (defclass foo () ()) 
#<STANDARD-CLASS FOO 

> (make-instance 'foo) 
#<F00 @ #x717910a2> 

> (class-of (make-instance 



'foo)) 



;A 'normal' class 

;A 'normal' instance 
;Note #<CLASS INSTANCE> 
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A Metaclasse standard-class 



> (defclass foo () ()) 
#<STANDARD-CLASS FOO 

> (make-instance 'foo) 
#<F00 @ #x717910a2> 

> (class-of (make-instance 'foo)) 
#<STANDARD-CLASS F00> 



;A 'normal' class 

;A 'normal' instance 
;Note #<CLASS INSTANCE> 

;Note #<METACLASS CLASS> 



msm 
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A Metaclasse standard-class 



> (defclass foo () ()) 
#<STANDARD-CLASS FOO 

> (make-instance 'foo) 
#<F00 @ #x717910a2> 

> (class-of (make-instance 'foo)) 
#<STANDARD-CLASS F00> 

> (class-of (class-of (make-instance 'foo))) 



;A 'normal' class 

;A 'normal' instance 
;Note #<CLASS INSTANCE> 

:Note #<METACLASS CLASS> 



msm 
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A Metaclasse standard-class 


> (defclass foo () ()) 




;A 


'normal' class 


#<STANDARD-CLASS FOO 








> (make-instance 'foo) 




;A 


'normal' instance 


#<F00 @ #x717910a2> 




;Note #<CLASS INSTANCE> 


> (class-of (make-instance 


foo)) 






#<STANDARD-CLASS F00> 




;Note #<METACLASS CLASS> 


> (class-of (class-of (make 


-instance 


'foo))) 


#<STANDARD-CLASS STANDARD-CLASS> 


; STANDARD-CLASS metaclass 
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A Metaclasse standard-class 



> (defclass foo () ()) 
#<STANDARD-CLASS FOO 

> (make-instance 'foo) 
#<F00 @ #x717910a2> 

> (class-of (make-instance 'foo)) 
#<STANDARD-CLASS F00> 

> (class-of (class-of (make-instance 'foo))) 
#<STANDARD-CLASS STANDARD-CLASS> ; STANDARD-CLASS metaclass 

> (class-of (class-of (class-of (make-instance 'foo)))) 



;A 'normal' class 

;A 'normal' instance 
;Note #<CLASS INSTANCE> 

:Note #<METACLASS CLASS> 



msm 



oãm 



■aaiBiiKUStH 



A Metaclasse standard-class 



> (defclass foo () ()) 
#<STANDARD-CLASS FOO 

> (make-instance 'foo) 
#<F00 @ #x717910a2> 

> (class-of (make-instance 'foo)) 
#<STANDARD-CLASS F00> 

> (class-of (class-of (make-instance 'foo))) 
#<STANDARD-CLASS STANDARD-CLASS> ; STANDARD-CLASS metaclass 

> (class-of (class-of (class-of (make-instance 'foo)))) 
#<STANDARD-CLASS STANDARD-CLASS> ;Looping 



;A 'normal' class 

;A 'normal' instance 
;Note #<CLASS INSTANCE> 

;Note #<METACLASS CLASS> 



A Metaclasse built-in-class 



mau 
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A Metaclasse standard-class 



> (defclass foo () ()) 
#<STANDARD-CLASS FOO 

> (make-instance 'foo) 
#<F00 @ #x717910a2> 

> (class-of (make-instance 'foo)) 
#<STANDARD-CLASS F00> 

> (class-of (class-of (make-instance 'foo))) 
#<STANDARD-CLASS STANDARD-CLASS> ; STANDARD-CLASS metaclass 

> (class-of (class-of (class-of (make-instance 'foo)))) 
#<STANDARD-CLASS STANDARD-CLASS> ;Looping 



;A 'normal' class 

;A 'normal' instance 
;Note #<CLASS INSTANCE> 

;Note #<METACLASS CLASS> 



A Metaclasse built-in-class 



> (class-of 1) 



mau 
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A Metaclasse standard-class 



> (defclass foo () ()) 
#<STANDARD-CLASS FOO 

> (make-instance 'foo) 
#<F00 @ #x717910a2> 

> (class-of (make-instance 'foo)) 
#<STANDARD-CLASS F00> 

> (class-of (class-of (make-instance 'foo))) 
#<STANDARD-CLASS STANDARD-CLASS> ; STANDARD-CLASS metaclass 

> (class-of (class-of (class-of (make-instance 'foo)))) 
#<STANDARD-CLASS STANDARD-CLASS> ;Looping 



;A 'normal' class 

;A 'normal' instance 
;Note #<CLASS INSTANCE> 

;Note #<METACLASS CLASS> 



A Metaclasse built-in-class 



> (class-of 1) 
#<BUILT-IN-CLASS FIXNUM> 



;Note #<METACLASS CLASS> 



mau 
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A Metaclasse standard-class 



> (defclass foo () ()) 
#<STANDARD-CLASS FOO 

> (make-instance 'foo) 
#<F00 @ #x717910a2> 

> (class-of (make-instance 'foo)) 
#<STANDARD-CLASS F00> 

> (class-of (class-of (make-instance 'foo))) 
#<STANDARD-CLASS STANDARD-CLASS> ; STANDARD-CLASS metaclass 

> (class-of (class-of (class-of (make-instance 'foo)))) 
#<STANDARD-CLASS STANDARD-CLASS> ;Looping 



;A 'normal' class 

;A 'normal' instance 
;Note #<CLASS INSTANCE> 

;Note #<METACLASS CLASS> 



A Metaclasse built-in-class 



> (class-of 1) 
#<BUILT-IN-CLASS FIXNUM> 

> (class-of (class-of 1)) 



;Note #<METACLASS CLASS> 
;The metaclass of 1 



mau 
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A Metaclasse standard-class 



> (defclass foo () ()) 
#<STANDARD-CLASS FOO 

> (make-instance 'foo) 
#<F00 @ #x717910a2> 

> (class-of (make-instance 'foo)) 
#<STANDARD-CLASS F00> 

> (class-of (class-of (make-instance 'foo))) 
#<STANDARD-CLASS STANDARD-CLASS> ; STANDARD-CLASS metaclass 

> (class-of (class-of (class-of (make-instance 'foo)))) 
#<STANDARD-CLASS STANDARD-CLASS> ;Looping 



;A 'normal' class 

;A 'normal' instance 
;Note #<CLASS INSTANCE> 

;Note #<METACLASS CLASS> 



A Metaclasse built-in-class 



> (class-of 1) 
#<BUILT-IN-CLASS FIXNUM> 

> (class-of (class-of 1)) 
#<STANDARD-CLASS BUILT-IN-CLASS> 



;Note #<METACLASS CLASS> 
;The metaclass of 1 
:is BUILT-IN-CLASS 



mau 
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A Metaclasse standard-class 



> (defclass foo () ()) 
#<STANDARD-CLASS FOO 

> (make-instance 'foo) 
#<F00 @ #x717910a2> 

> (class-of (make-instance 'foo)) 
#<STANDARD-CLASS F00> 

> (class-of (class-of (make-instance 'foo))) 
#<STANDARD-CLASS STANDARD-CLASS> ; STANDARD-CLASS metaclass 

> (class-of (class-of (class-of (make-instance 'foo)))) 
#<STANDARD-CLASS STANDARD-CLASS> ;Looping 



;A 'normal' class 

;A 'normal' instance 
;Note #<CLASS INSTANCE> 

;Note #<METACLASS CLASS> 



A Metaclasse built-in-class 



> (class-of 1) 

#<BUILT-IN-CLASS FIXNUM> ;Note #<METACLASS CLASS> 

> (class-of (class-of 1)) ;The metaclass of 1 
#<STANDARD-CLASS BUILT-IN-CLASS> ; is BUILT-IN-CLASS 

> (class-of (class-of (class-of l)));The metaclass of FIXNUM 



mau 
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A Metaclasse standard-class 



> (defclass foo () ()) 
#<STANDARD-CLASS FOO 

> (make-instance 'foo) 
#<F00 @ #x717910a2> 

> (class-of (make-instance 'foo)) 
#<STANDARD-CLASS F00> 

> (class-of (class-of (make-instance 'foo))) 
#<STANDARD-CLASS STANDARD-CLASS> ; STANDARD-CLASS metaclass 

> (class-of (class-of (class-of (make-instance 'foo)))) 
#<STANDARD-CLASS STANDARD-CLASS> ;Looping 



;A 'normal' class 

;A 'normal' instance 
;Note #<CLASS INSTANCE> 

;Note #<METACLASS CLASS> 



A Metaclasse built-in-class 




> (class-of 1) 








#<BUILT-IN-CLASS FIXNUM> 




;Note #<METACLASS CLASS> 




> (class-of (class-of 1)) 




;The metaclass of 1 




#<STANDARD-CLASS BUILT-IN-CLASS> 




;is BUILT-IN-CLASS 




> (class-of (class-of (class-of 


1))) 


;The metaclass of FIXNUM 




#<STANDARD-CLASS STANDARD-CLASS> 




;is STANDARD-CLASS 
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A Metaclasse f orward-referenced-class 



> (defclass bar (baz) ()) 



;The class baz is not defined yet . 



msm 
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A Metaclasse f orward-referenced-class 



> (defclass bar (baz) ()) 
#<STANDARD-CLASS BAR> 



;The class baz is not defined yet . 



msm 



oãm 



■aaiBiiKUStH 



A Metaclasse f orward-referenced-class 



> (defclass bar (baz) ()) ;The class baz is not defined yet . 
#<STANDARD-CLASS BAR> 

> (setq baz-class 

(first (class-direct-superclasses (find-class 'bar)))) 



msm 
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A Metaclasse f orward-referenced-class 



> (defclass bar (baz) ()) ;The class baz is not defined yet . 
#<STANDARD-CLASS BAR> 

> (setq baz-class 

(first (class-direct-superclasses (find-class 'bar)))) 
#<FORWARD-REFERENCED-CLASS BAZ> ; . . .but it exists already. . . 



msm 
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A Metaclasse f orward-referenced-class 



;The class baz is not defined yet . 



> (def class bar (baz) ()) 
#<STANDARD-CLASS BAR> 

> (setq baz-class 

(first (class-direct-superclasses (find-class 'bar)))) 
#<FORWARD-REFERENCED-CLASS BAZ> ; . . .but it exists already. . . 

> (class-of baz-class) 



msm 
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A Metaclasse f orward-referenced-class 



;The class baz is not defined yet . 



> (def class bar (baz) ()) 
#<STANDARD-CLASS BAR> 

> (setq baz-class 

(first (class-direct-superclasses (find-class 'bar)))) 
#<FORWARD-REFERENCED-CLASS BAZ> ; . . .but it exists already. . . 

> (class-of baz-class) 
#<STANDARD-CLASS FORWARD-REFERENCED-CLASS> 



msm 
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A Metaclasse f orward-referenced-class 



;The class baz is not defined yet . 



> (def class bar (baz) ()) 
#<STANDARD-CLASS BAR> 

> (setq baz-class 

(first (class-direct-superclasses (find-class 'bar)))) 
#<FORWARD-REFERENCED-CLASS BAZ> ; . . .but it exists already. . . 

> (class-of baz-class) 
#<STANDARD-CLASS FORWARD-REFERENCED-CLASS> 



> (def class baz () ()) 



;We now define baz. . . 



msm 
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A Metaclasse f orward-referenced-class 



;The class baz is not defined yet . 



> (def class bar (baz) ()) 
#<STANDARD-CLASS BAR> 

> (setq baz-class 

(first (class-direct-superclasses (find-class 'bar)))) 
#<FORWARD-REFERENCED-CLASS BAZ> ; . . .but it exists already. . . 

> (class-of baz-class) 
#<STANDARD-CLASS FORWARD-REFERENCED-CLASS> 



> (def class baz () ()) 
#<STANDARD-CLASS BAZ> 



;We now define baz. 



msm 
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A Metaclasse f orward 


-referenced-class 








1 


> (defclass bar (baz) 


()) ;The class 


baz is 


not 


def ined 


yet . . . 


#<STANDARD-CLASS BAR> 












> (setq baz-class 












(first (class-dire 


ct-superclasses (find- 


-class 


'bar 


)))) 




#<FORWARD-REFERENCED-CLASS BAZ> ; . . . but it 


exists 


already. . . 




> (class-of baz-class) 












#<STANDARD-CLASS FORWARD-REFERENCED-CLASS> 










> (defclass baz () ()) 


;We now define baz. 








#<STANDARD-CLASS BAZ> 












> baz-class 


; . . . and the saved cl 


ass 







msm 
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A Metaclasse f orward-referenced-class 


> (defclass bar (baz) ()) ;The class baz is 


not defined yet . . . 


#<STANDARD-CLASS BAR> 




> (setq baz-class 




(first (class-direct-superclasses (find-class 


'bar)))) 


#<FORWARD-REFERENCED-CLASS BAZ> ; . . .but it exists 


already. . . 


> (class-of baz-class) 




#<STANDARD-CLASS FORWARD-REFERENCED-CLASS> 




> (defclass baz () ()) ;We now define baz. 




#<STANDARD-CLASS BAZ> 




> baz-class ; . . . and the saved cl 


1SS 


#<STANDARD-CLASS BAZ> jchanges to a become 


a different thing 



A função change-class 



••".O 



.— _— — 
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A Metaclasse f orward-referenced-class 


> (defclass bar (baz) ()) ;The class baz is 


not defined yet . . . 


#<STANDARD-CLASS BAR> 




> (setq baz-class 




(first (class-direct-superclasses (find-class 


'bar)))) 


#<FORWARD-REFERENCED-CLASS BAZ> ; . . .but it exists 


already. . . 


> (class-of baz-class) 




#<STANDARD-CLASS FORWARD-REFERENCED-CLASS> 




> (defclass baz () ()) ;We now define baz. 




#<STANDARD-CLASS BAZ> 




> baz-class ; . . . and the saved cl 


1SS 


#<STANDARD-CLASS BAZ> jchanges to a become 


a different thing 



A função change-class 



> (setq foo-instance (make-instance 'foo)) ;;A normal instance 



4.O 



.— _— — 
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A Metaclasse f orward-referenced-class 


> (defclass bar (baz) ()) ;The class baz is 


not defined yet . . . 


#<STANDARD-CLASS BAR> 




> (setq baz-class 




(first (class-direct-superclasses (find-class 


'bar)))) 


#<FORWARD-REFERENCED-CLASS BAZ> ; . . .but it exists 


already. . . 


> (class-of baz-class) 




#<STANDARD-CLASS FORWARD-REFERENCED-CLASS> 




> (defclass baz () ()) ;We now define baz. 




#<STANDARD-CLASS BAZ> 




> baz-class ; . . . and the saved cl 


1SS 


#<STANDARD-CLASS BAZ> jchanges to a become 


a different thing 



A função change-class 



> (setq foo-instance (make-instance 'foo)) ;;A normal instance 
#<F00 @ #x717a0562> 



e— sa 
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A Metaclasse f orward-referenced-class 


> (defclass bar (baz) ()) ;The class baz is 


not defined yet . . . 


#<STANDARD-CLASS BAR> 




> (setq baz-class 




(first (class-direct-superclasses (find-class 


'bar)))) 


#<FORWARD-REFERENCED-CLASS BAZ> ; . . .but it exists 


already. . . 


> (class-of baz-class) 




#<STANDARD-CLASS FORWARD-REFERENCED-CLASS> 




> (defclass baz () ()) ;We now define baz. 




#<STANDARD-CLASS BAZ> 




> baz-class ; . . . and the saved cl 


1SS 


#<STANDARD-CLASS BAZ> jchanges to a become 


a different thing 



A função change-class 



> (setq foo-instance (make-instance 'foo)) ;;A normal instance 
#<F00 @ #x717a0562> 

> (change-class foo-instance 'baz) ;;Can we change its class? 






f\o- 



t-mmmmmm.\mm 



■aaiBiiKUStH 



A Metaclasse f orward-referenced-class 


> (defclass bar (baz) ()) ;The class baz is 


not defined yet . . . 


#<STANDARD-CLASS BAR> 




> (setq baz-class 




(first (class-direct-superclasses (find-class 


'bar)))) 


#<FORWARD-REFERENCED-CLASS BAZ> ; . . .but it exists 


already. . . 


> (class-of baz-class) 




#<STANDARD-CLASS FORWARD-REFERENCED-CLASS> 




> (defclass baz () ()) ;We now define baz. 




#<STANDARD-CLASS BAZ> 




> baz-class ; . . . and the saved cl 


1SS 


#<STANDARD-CLASS BAZ> jchanges to a become 


a different thing 



A função change-class 



> (setq foo-instance (make-instance 'foo)) ;;A normal instance 
#<F00 @ #x717a0562> 

> (change-class foo-instance 'baz) ;;Can we change its class? 
#<BAZ @ #x717a0562> 



f\o- 



t-mmmmmm.\mm 
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A Metaclasse f orward-referenced-class 


> (defclass bar (baz) ()) ;The class baz is 


not defined yet . . . 


#<STANDARD-CLASS BAR> 




> (setq baz-class 




(first (class-direct-superclasses (find-class 


'bar)))) 


#<FORWARD-REFERENCED-CLASS BAZ> ; . . .but it exists 


already. . . 


> (class-of baz-class) 




#<STANDARD-CLASS FORWARD-REFERENCED-CLASS> 




> (defclass baz () ()) ;We now define baz. 




#<STANDARD-CLASS BAZ> 




> baz-class ; . . . and the saved cl 


1SS 


#<STANDARD-CLASS BAZ> jchanges to a become 


a different thing 



A função change-class 



> (setq foo-instance (make-instance 'foo)) ;;A normal instance 
#<F00 @ #x717a0562> 

> (change-class foo-instance 'baz) ;;Can we change its class? 
#<BAZ @ #x717a0562> 

> foo-instance 



f\o- 



t-mmmmmm.\mm 
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A Metaclasse f orward-referenced-class 


> (defclass bar (baz) ()) ;The class baz is 


not defined yet . . . 


#<STANDARD-CLASS BAR> 




> (setq baz-class 




(first (class-direct-superclasses (find-class 


'bar)))) 


#<FORWARD-REFERENCED-CLASS BAZ> ; . . .but it exists 


already. . . 


> (class-of baz-class) 




#<STANDARD-CLASS FORWARD-REFERENCED-CLASS> 




> (defclass baz () ()) ;We now define baz. 




#<STANDARD-CLASS BAZ> 




> baz-class ; . . . and the saved cl 


1SS 


#<STANDARD-CLASS BAZ> jchanges to a become 


a different thing 



A função change-class 



> (setq foo-instance (make-instance 'foo)) ;;A normal instance 
#<F00 @ #x717a0562> 

> (change-class foo-instance 'baz) ;;Can we change its class? 
#<BAZ @ #x717a0562> 

> foo-instance 

#<BAZ @ #x717a0562> ;;Yes, we can! 



e— sa 



KBilBSffilifl 



Para se obter uma classe 



• A partir de um objecto foo: 
(class-of foo) 

9 A partir do nome de um tipo ' bar: 
(f ind-class ' bar) 



Exemplo 



> (class-of 
#<BUILT-IN-CLASS STRINO 

> (f ind-class ' string) 
#<BUILT-IN-CLASS STRINO 

> (defclass foo () ()) 
#<STANDARD-CLASS F00> 

> (find-class 'foo) 
#<STANDARD-CLASS F00> 



tSBSm 
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Nomes de Classes vs Classes 



• Uma classe tem um nome (para melhor visualização). 

• Um nome está associado a uma classe (para mais fácil acesso). 

• Em geral: 

• (class-name (find-class foo))=foo 

• (find-class (class-name foo))=foo 



• Mas pode-se mudar. 



Exemplo 



> (defclass foo () ()) 
#<STANDARD-CLASS F00> 

> (find-class 'foo) 
#<STANDARD-CLASS F00> 

> (class-name (find-class 
FOO 



'foo)) 



Kimttff»,™ 
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Nomes de Classes vs Classes 



> (setf my-foo (make-instance 
#<F00 @ #x71788672> 



'foo));Let's save a foo instance 



msm 



oãm 
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Nomes de Classes vs Classes 



> (setf my-foo (make-instance 'f oo) ) ;Let ' s save a foo instance 
#<F00 @ #x71788672> 

> (setf (class-name (find-class 'foo)) 'bar) ;Change class name 
BAR 






msm 



oãm 
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Nomes de Classes vs Classes 



> (setf my-foo (make-instance 'f oo) ) ;Let ' s save a foo instance 
#<F00 @ #x71788672> 

> (setf (class-name (find-class 'foo)) 'bar) ;Change class name 
BAR 

> my-foo ; Our instance is the same 



msm 



oãm 
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Nomes de Classes vs Classes 



> (setf my-foo (make-instance 'f oo) ) ;Let ' s save a foo instance 
#<F00 @ #x71788672> 

> (setf (class-name (find-class 'foo)) 'bar) ;Change class name 
BAR 

> my-foo ; Our instance is the same 
#<BAR @ #x71788672> 



msm 



oãm 
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Nomes de Classes vs Classes 



> (setf my-foo (make-instance 'foo));Let's save a foo instance 
#<F00 @ #x71788672> 

> (setf (class-name (find-class 'foo)) 'bar) ;Change class name 
BAR 

> my-foo ; Our instance is the same 
#<BAR @ #x71788672> 

> (make-instance 'foo) ;foo references the same class 



msm 



oãm 
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Nomes de Classes vs Classes 



> (setf my-foo (make-instance 'foo));Let's save a foo instance 
#<F00 @ #x71788672> 

> (setf (class-name (find-class 'foo)) 'bar) ;Change class name 
BAR 

> my-foo ; Our instance is the same 
#<BAR @ #x71788672> 

> (make-instance 'foo) ;foo references the same class 
#<BAR #x715ea4b2> 
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Nomes de Classes vs Classes 



> (setf my-foo (make-instance 'foo));Let's save a foo instance 
#<F00 @ #x71788672> 

> (setf (class-name (find-class 'foo)) 'bar) ;Change class name 
BAR 

> my-foo ; Our instance is the same 
#<BAR @ #x71788672> 

> (make-instance 'foo) ;foo references the same class 
#<BAR @ #x715ea4b2> 

> (make-instance 'bar) 
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Nomes de Classes vs Classes 


> (setf 


my-foo (make-instance 'f 


oo)) 


;Let 


s save a foo instance 


#<F00 © 


#x71788672> 












> (setf 


(class-name (find-class 


'foo 


)) 'bar) 


; Change 


class name 


BAR 














> my-foo 




;0ur 


insl 


ance is 


the same 


#<BAR @ 


#x71788672> 












> (make- 


■instance 'foo) 




; foo 


references the same class 


#<BAR 


#x715ea4b2> 












> (make- 


■instance 'bar) 












Error No class named: BAR. 




;but 


bar 


doesn't 
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Nomes de Classes vs Classes 


> (setf 


my-foo (make-instance 'f 


oo)) 


;Let 


' s save a 


foo instance 


#<F00 © 


#x71788672> 
















> (setf 


(class-name (find- 


class 


'foo 


)) 'bar) 


; Change 


class name 


BAR 


















> my-foo 






;0ur 


insl 


ance 


is 


the same 


#<BAR @ 


#x71788672> 
















> (make- 


■instance 'foo) 






; foo 


references the same class 


#<BAR 


#x715ea4b2> 
















> (make- 


■instance 'bar) 
















Error No class named: BAR. 






;but 


bar 


doesn't 




> (setf 


(find-class 'bar) 


(find- 


class 'f 


do)) 


;Now 


it 


does 
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Nomes de Classes vs Classes 


> (setf 


my-foo (make-instance 'f 


oo)) 


;Let 


' s save a 


foo instance 


#<F00 © 


#x71788672> 
















> (setf 


(class-name (find- 


class 


'foo 


)) 'bar) 


; Change 


class name 


BAR 


















> my-foo 






;0ur 


insl 


ance 


is 


the same 


#<BAR @ 


#x71788672> 
















> (make- 


■instance 'foo) 






; foo 


references the same class 


#<BAR 


#x715ea4b2> 
















> (make- 


■instance 'bar) 
















Error No class named: BAR. 






;but 


bar 


doesn't 




> (setf 


(find-class 'bar) 


(find- 


class 'f 


do)) 


;Now 


it 


does 


#<STANDARD-CLASS BAR> 
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Nomes de Classes vs Classes 


> (setf 


my-foo (make-instance 'f 


oo) ) ;Let 


's save a foo instance 


#<F00 © 


#x71788672> 










> (setf 


(class-name (find- 


class 


'foo)) ' 


oar) ;Change 


class name 


BAR 












> my-foo 




;0ur 


instance is 


the same 


#<BAR @ 


#x71788672> 










> (make- 


-instance 'foo) 




;f oo 


references the same class 


#<BAR 


#x715ea4b2> 










> (make- 


-instance 'bar) 










Error No class named: BAR. 




;but 


bar doesn't 




> (setf 


(find-class 'bar) 


(find- 


class 'f 


ao)) ;Now it 


does 


#<STANDARD-CLASS BAR> 










> (make- 


-instance 'bar) 




;bar 


is the same 


:lass. . . 


#<BAR a 


#x717c874a> 
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Nomes de Classes vs Classes 



> (setf my-foo (make-instance 'foo));Let's save a foo instance 
#<F00 @ #x71788672> 

> (setf (class-name (find-class 'foo)) 'bar) ;Change class name 
BAR 

> my-foo ; Our instance is the same 
#<BAR @ #x71788672> 

> (make-instance 'foo) ;foo references the same class 
#<BAR @ #x715ea4b2> 

> (make-instance 'bar) 

Error No class named: BAR. ;but bar doesn't 

> (setf (find-class 'bar) (find-class 'foo)) ;Now it does 
#<STANDARD-CLASS BAR> 

> (make-instance 'bar) ;bar is the same class... 
#<BAR @ #x717c874a> 

> (make-instance 'foo) ; ... as foo 
#<BAR #x717cef6a> 
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Nomes de Classes vs Classes 



> (setf my-foo (make-instance 'f oo) ) ;Let ' s save a foo instance 
#<F00 @ #x71788672> 

> (setf (class-name (find-class 'foo)) 'bar) ;Change class name 
BAR 

> my-foo ; Our instance is the same 
#<BAR @ #x71788672> 

> (make-instance 'foo) ;foo references the same class 
#<BAR @ #x715ea4b2> 

> (make-instance 'bar) 

Error No class named: BAR. ;but bar doesn't 

> (setf (find-class 'bar) (find-class 'foo)) ;Now it does 
#<STANDARD-CLASS BAR> 

> (make-instance 'bar) 
#<BAR @ #x717c874a> 

> (make-instance 'foo) 
#<BAR @ #x717cef6a> 

> (setf (find-class 'foo) nil) 
NIL 



bar is the same class... 

. . .as foo 

foo doesn't reference the class 
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Nomes de Classes vs Classes 



> (setf my-foo (make-instance 'foo));Let's save a foo instance 
#<F00 @ #x71788672> 

> (setf (class-name (find-class 'foo)) 'bar) ;Change class name 
BAR 

> my-foo ; Our instance is the same 
#<BAR @ #x71788672> 

> (make-instance 'foo) ;foo references the same class 
#<BAR @ #x715ea4b2> 

> (make-instance 'bar) 

Error No class named: BAR. ;but bar doesn't 

> (setf (find-class 'bar) (find-class 'foo)) ;Now it does 
#<STANDARD-CLASS BAR> 

> (make-instance 'bar) 
#<BAR @ #x717c874a> 

> (make-instance 'foo) 
#<BAR @ #x717cef6a> 

> (setf (find-class 'foo) nil) 
NIL 

> (make-instance 'foo) 



bar is the same class... 

. . .as foo 

foo doesn't reference the class 

so it can't be used 
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Nomes de Classes vs Classes 



> (setf my-foo (make-instance 'foo));Let's save a foo instance 
#<F00 @ #x71788672> 

> (setf (class-name (find-class 'foo)) 'bar) ;Change class name 
BAR 

> my-foo ; Our instance is the same 
#<BAR @ #x71788672> 

> (make-instance 'foo) ;foo references the same class 
#<BAR @ #x715ea4b2> 

> (make-instance 'bar) 

Error No class named: BAR. ;but bar doesn't 

> (setf (find-class 'bar) (find-class 'foo)) ;Now it does 
#<STANDARD-CLASS BAR> 



> (make-instance 'bar) 
#<BAR @ #x717c874a> 

> (make-instance 'foo) 
#<BAR @ #x717cef6a> 

> (setf (find-class 'foo) nil) 
NIL 

> (make-instance 'foo) 
Error No class named: FOO. 



bar is the same class... 

. . .as foo 

foo doesn't reference the class 

so it can't be used 



mau 
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A Função Genérica make-instance 



(defgeneric make-instance (class ferest initargs)) 



Método especializado para símbolos 



(defmethod make-instance ((class symbol) ferest initargs) 
(apply #' make-instance (find-class class) initargs)) 



Método especializado para classes 



(defmethod make-instance ((class class) fcrest initargs) 

(let ((instance (apply # ' allocate-instance class initargs))) 
(apply # ' initialize-instance instance initargs) 
instance)) 



Optimizador 



(def ine-compiler-macro make-instance (class-expr fcrest init-exprs) 
(if (and (consp class-expr) (eq (first class-expr) 'quote)) 

(make-instance->constructor-call (second class-expr) init-exprs) 
...)) 



arena.™ 
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Exemplo: Classes Anónimas 



• Criar uma classe com um nome único. 

• Criar uma instância a partir dessa classe. 



A Macro anonymous-class 



(defmacro anonymous-class (supers slots ferest options) 
" (def class , (gensym) , supers , slots , Ooptions)) 



Exemplo 



> (draw (make-instance (anonymous-class (color-mixin circle) 

((filled? :ii ;form t : filled?))) 
: color :blue 
: radius 3) 
(make-instance ' colored-printer) ) 
changing printer ink color to BLUE 
drawing an circle on printer! 
changing printer ink color to BLACK 
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A expressão (slot-value obj nome) devolve o valor do slot 
nome no obj. 

Se não existir o slot, invoca a função genérica slot-missing: 
(slot-missing (class-of obj) obj nome 'slot-value) 

Se existir o slot mas estiver sem valor, invoca a função genérica 

slot-unbound: 

(slot-unbound (class-of obj) obj nome) 

A expressão (setf (slot-value obj nome) novo-valor) 
altera o valor do slot nome no obj. 

Se não existir o slot, invoca a função genérica slot-missing: 
(slot-missing (class-of obj) obj nome 'setf novo-valor) 
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(defclass foo () 
((slotl))) 

> (setq my-foo (make-instance 'foo)) 
#<F00 @ #x71648d6a> 

> (* (slot-value my-foo 'slotl) 2) 



MBMffMm; 



(defclass foo () 
((slotl))) 

> (setq my-foo (make-instance 'foo)) 
#<F00 @ #x71648d6a> 

> (* (slot-value my-foo 'slotl) 2) 

The slot SL0T1 is unbound in the object #<F00 @ #x7161dfaa> of class 
#<STANDARD-CLASS F00> . 

[Condition of type UNBOUND-SLOT] 



*BMffi.'.m; 



(defclass foo () 
((slotl))) 

> (setq my-foo (make-instance 'foo)) 
#<F00 @ #x71648d6a> 

> (* (slot-value my-foo 'slotl) 2) 

The slot SL0T1 is unbound in the object #<F00 @ #x7161dfaa> of class 
#<STANDARD-CLASS F00> . 

[Condition of type UNBOUND-SLOT] 



Restarts : 

1 
2 
3 



[TRY-AGAIN] Try accessing the slot again 
[USE-VALUE] Return a value 
[STORE-VALUE] Store a value and return it 
[ABORT] Return to SLIME's top levei. 
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(defclass foo () 
((slotl))) 

> (setq my-foo (make-instance 'foo)) 
#<F00 @ #x71648d6a> 

> (* (slot-value my-foo 'slotl) 2) 

The slot SL0T1 is unbound in the object #<F00 @ #x7161dfaa> of class 
#<STANDARD-CLASS F00> . 

[Condition of type UNBOUND-SLOT] 



Restarts : 

1 
2 
3 



[TRY-AGAIN] Try accessing the slot again 
[USE-VALUE] Return a value 
[STORE-VALUE] Store a value and return it 
[ABORT] Return to SLIME's top levei. 



:C 2 
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(defclass foo () 
((slotl))) 

> (setq my-foo (make-instance 'foo)) 
#<F00 @ #x71648d6a> 

> (* (slot-value my-foo 'slotl) 2) 

The slot SL0T1 is unbound in the object #<F00 @ #x7161dfaa> of class 
#<STANDARD-CLASS F00> . 

[Condition of type UNBOUND-SLOT] 

Restarts : 



[TRY-AGAIN] Try accessing the slot again 
[USE-VALUE] Return a value 
[STORE-VALUE] Store a value and return it 
[ABORT] Return to SLIME's top levei. 



:C 2 

enter expression which will evaluate to a value to use: 25 
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(defclass foo () 
((slotl))) 

> (setq my-foo (make-instance 'foo)) 
#<F00 @ #x71648d6a> 

> (* (slot-value my-foo 'slotl) 2) 

The slot SL0T1 is unbound in the object #<F00 @ #x7161dfaa> of class 
#<STANDARD-CLASS F00> . 

[Condition of type UNBOUND-SLOT] 

Restarts : 



[TRY-AGAIN] Try accessing the slot again 
[USE-VALUE] Return a value 
[STORE-VALUE] Store a value and return it 
[ABORT] Return to SLIME's top levei. 



:C 2 

enter expression which will evaluate to a value to use: 25 
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(defclass foo () 
((slotl))) 

> (setq my-foo (make-instance 'foo)) 
#<F00 @ #x71648d6a> 

> (* (slot-value my-foo 'slotl) 2) 

The slot SL0T1 is unbound in the object #<F00 @ #x7161dfaa> of class 
#<STANDARD-CLASS F00> . 

[Condition of type UNBOUND-SLOT] 

Restarts : 



[TRY-AGAIN] Try accessing the slot again 
[USE-VALUE] Return a value 
[STORE-VALUE] Store a value and return it 
[ABORT] Return to SLIME's top levei. 



:C 2 

enter expression which will evaluate to a value to use: 25 
50 
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(defclass foo () 
((slotl))) 

> (setq my-foo (make-instance 'foo)) 
#<F00 @ #x71648d6a> 

> (* (slot-value my-foo 'slotl) 2) 

The slot SL0T1 is unbound in the object #<F00 @ #x7161dfaa> of class 
#<STANDARD-CLASS F00> . 

[Condition of type UNBOUND-SLOT] 



Restarts : 
0: [TRY-AGAIN] Try accessing the slot again 
1: [USE- VALUE] Return a value 
2: [ST0RE- VALUE] Store a value and return it 
3: [ABORT] Return to SLIME's top levei. 

:C2 

enter expression which will evaluate to a value to use: 25 

50 

CL-USER> (slot-value my-foo 'slotl) 
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(defclass foo () 
((slotl))) 

> (setq my-foo (make-instance 'foo)) 
#<F00 @ #x71648d6a> 

> (* (slot-value my-foo 'slotl) 2) 

The slot SL0T1 is unbound in the object #<F00 @ #x7161dfaa> of class 
#<STANDARD-CLASS F00> . 

[Condition of type UNBOUND-SLOT] 



Restarts : 
0: [TRY-AGAIN] Try accessing the slot again 
1: [USE- VALUE] Return a value 
2: [ST0RE- VALUE] Store a value and return it 
3: [ABORT] Return to SLIME's top levei. 

:C2 

enter expression which will evaluate to a value to use: 25 

50 

CL-USER> (slot-value my-foo 'slotl) 

25 
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• slot-value e (setf slot-value) são funções... 

• ... mas não são funções genéricas. 

• Mas, nas implementações que incluem o MOP (todas, 
actualmente), invocam as funções genéricas 
slot-value-using-class e 

(setf slot-value-using-class) 



A Função (não-genérica) slot-value 



(defun slot-value (object slot-name) 
(let* ((class (class-of object)) 

(slot-def inition (f ind-slot-def inition class slot-name))) 
(if (null slot-def inition) 

(slot-missing class object slot-name 'slot-value) 
(slot-value-using-class class object slot-def inition)) ) ) 
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A Função Genérica slot-value-using-clas; 



(defmethod slot-value-using-class 
((class standard-class) 
(object standard-object) 

(slotd standard-ef f ective-slot-def inition) ) 
(if ... 

(slot-unbound class object (slot-def inition-name slotd)) 



.)) 



A Função Genérica slot-unbound 



(defmethod slot-unbound ((class t) instance slot-name) 
(restart-case 

(error 'unbound-slot e slot-name : instance) 
(use-value (value) 

...) 
(store-value (new-value) 
...))) 
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Protocolo 



Modelo abstracto do comportamento de um sistema. 



Protocolo 



Conjunto de funções genéricas que colaboram para um mesmo fim. 



Protocolos em CLOS 



• Criação e inicialização de instância 

• Reinicialização de instância 

• Mudança da classe de instância 

• Redefinição de classes 

• Acesso a slot de instância 

• Invocação de função genérica 



Kimttff»,™ 
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Criação de Instância 



O Combinar inicializações explícitas (make-instance) com valores 
de omissão (:default-initargs e : initf orms). 

O Verificar a validade das inicializações. 

O Alocação de espaço físico para a instância (allocate-instance). 

O Preenchimento dos slots usando as inicializações 
(initialize-instance e shared-initialize). 
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Criação de Instância 



• make-instance invoca allocate-instance e, depois, 
initialize-instance. 

• allocate-instance aloca o espaço físico para a instância. 

• initialize-instance invoca shared-initialize. 

• shared-initialize atribui os slots com base nos : initargs, 
:default-initargs e : initf oras. 
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Criação de Instância - make-instance 



(defmethod make-instance ((class class) fcrest initargs) 

; ; Verify initialization validity 

(let ((instance (apply # ' allocate-instance class initargs))) 
(apply # ' initialize-instance instance initargs) 
instance)) 



Criação de Instância - initialize-instance 



(defmethod initialize-instance ((instance standard-object) 

fcrest initargs fckey) 
(apply #' shared-initialize instance t initargs)) 
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Mudança da Classe de Instância 



O Modificação da estrutura da instância por adição de novos slots e 
eliminação dos não existentes na futura classe. 

O Preenchimento dos slots novos usando as inicializações 
(update- instance-for-different-class e 
shared-initialize). 



Mudança da Classe de Instância 



• change-class modifica um objecto para ser uma instância de 
uma classe diferente. 

• change-class invoca 

update- instance-for-different-class. 

• update-instance-f or-different-class invoca 
shared-initialize. 
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Mudança da Classe de Instância 



(defmethod change-class ((instance standard-object) 

(new-class standard-class) 
fcrest initargs &key) 
(let* ((old-class (class-of instance)) 

(new- instance (allocate-instance new-class)) 
(old-slots (get-slots instance)) 
(new-slots (get-slots new- instance)) ) 
; ; Copy shared slots 

;; Make the old instance point to the new storage. 
(apply # 'update-instance-f or-dif f erent-class 
new-instance 
instance 
initargs) 
instance)) 

(defmethod updat e-instance-f or-dif f erent-class 

((previous standard-object) (current standard-object) 
ftrest initargs &key) 

(apply # ' shared-initialize current added-slots initargs))) 
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Redefinição da Classe de Instância 



O Modificação da estrutura da classe já existente. 

O Se ocorrer adição e/ou remoção de slots e/ou alteração da ordem 
dos slots, as instâncias já existentes são actualizadas (num 
instante indeterminado mas antes de qualquer acesso aos slots). 

Q Para cada instância, modificação da estrutura da instância por 
adição de novos slots e eliminação dos não existentes na futura 
classe. 

O Preenchimento dos slots novos usando as inicializações 
(update-instance-for-redef ined-class e 
shared-initialize). 
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Redefinição da Classe de Instância 



• make-instances-obsolete modifica os objectos para 
reflectirem a nova definição da classe. 

• make-instances-obsolete invoca (num instance 
indeterminado) update -instance-f or-redef ined-class para 
cada instância. 

• update-instance-f or-redef ined-class invoca 
shared-initialize. 

• shared-initialize atribui os slots com base nos : initargs, 
:default-initargs e : initf orms. 



msm 
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Redefinição da Classe de Instância 



(defclass complex-number () 
((real :real) 

(imag imag))) 



;Define (rectangular) complex-number 
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Redefinição da Classe de Instância 



(defclass complex-number () 
((real :real) 

(imag imag) ) ) 



;Define (rectangular) complex-number 



> (setq l+2i (make-instance 'complex-number 
#<COMPLEX-NUMBER @ #x717705a2> 



1 



2)) 



■aaiBiiKUStH 



Redefinição da Classe de Instância 



(defclass complex-number () 
((real :real) 

(imag imag) ) ) 



;Define (rectangular) complex-number 



> (setq l+2i (make-instance 'complex-number 
#<COMPLEX-NUMBER @ #x717705a2> 

> (setq 3+4i (make-instance 'complex-number 
#<COMPLEX-NUMBER @ #x717816b2> 



2)) 
4)) 
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Redefinição da Classe de Instância 



(defclass complex-number () 
((real :real) 

(imag imag) ) ) 



;Define (rectangular) complex-number 



> (setq l+2i (make-instance 'complex-number 
#<COMPLEX-NUMBER @ #x717705a2> 

> (setq 3+4i (make-instance 'complex-number 
#<COMPLEX-NUMBER @ #x717816b2> 

> (slot-value l+2i 'real) 
1 



2)) 
4)) 
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Redefinição da Classe de Instância 



(defclass complex-number () 
((real :real) 

(imag imag) ) ) 



;Define (rectangular) complex-number 



> (setq l+2i (make-instance 'complex-number 
#<COMPLEX-NUMBER @ #x717705a2> 

> (setq 3+4i (make-instance 'complex-number 
#<COMPLEX-NUMBER @ #x717816b2> 

> (slot-value l+2i 'real) 
1 



2)) 
4)) 



(defclass complex-number () 
((rho : initarg :rho) 
(theta :theta))) 



; Redefine (polar) complex-number 



■aaiBiiKUStH 



Redefinição da Classe de Instância 1 


(defclass complex-number () 
((real : initarg :real) 


;Define (rectangular) complex-number 


(imag imag) ) ) 




> (setq l+2i (make-instance 'complex-number 1 g 2) ) 
#<COMPLEX-NUMBER @ #x717705a2> 


> (setq 3+4i (make-instance 'complex-number 3 4)) 
#<COMPLEX-NUMBER @ #x717816b2> 


> (slot-value l+2i 'real) 
1 




(defclass complex-number () 
((rho : initarg :rho) 
(theta : initarg :theta))) 


; Redefine (polar) complex-number 


> (slot-value l+2i 'real) 


;The slot 'real' is gone 
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Redefinição da Classe de Instância 1 


(defclass complex-number () 
((real : initarg :real) 


;Define (rectangular) complex-number 


(imag imag) ) ) 




> (setq l+2i (make-instance 'complex-number 1 g 2) ) 
#<COMPLEX-NUMBER @ #x717705a2> 


> (setq 3+4i (make-instance 'complex-number 3 4)) 
#<COMPLEX-NUMBER @ #x717816b2> 


> (slot-value l+2i 'real) 
1 




(defclass complex-number () 
((rho : initarg :rho) 
(theta : initarg :theta))) 


; Redefine (polar) complex-number 


> (slot-value l+2i 'real) 


;The slot 'real' is gone 


The slot REAL is missing in 


the object #<COMPLEX-NUMBER @ #x717705a2> 
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Redefinição da Classe de Instância 



(defclass complex-number () ;Define (rectangular) complex-number 
((real : initarg :real) 
(imag imag) ) ) 



> (setq l+2i (make-instance 'complex-number 
#<COMPLEX-NUMBER @ #x717705a2> 

> (setq 3+4i (make-instance 'complex-number 
#<COMPLEX-NUMBER @ #x717816b2> 

> (slot-value l+2i 'real) 
1 



2)) 
4)) 



(defclass complex-number () ;Redefine (polar) complex-number 
((rho : initarg :rho) 
(theta initarg :theta))) 

> (slot-value l+2i 'real) ;The slot 'real' is gone 

The slot REAL is missing in the object #<COMPLEX-NUMBER @ #x717705a2> 



> (slot-value l+2i 'rho) 



;The slot 'rho' is unbound 
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Redefinição da Classe de Instância 



(defclass complex-number () ;Define (rectangular) complex-number 
((real :initarg :real) 
(imag imag) ) ) 



> (setq l+2i (make-instance 'complex-number 
#<COMPLEX-NUMBER @ #x717705a2> 

> (setq 3+4i (make-instance 'complex-number 
#<COMPLEX-NUMBER @ #x717816b2> 

> (slot-value l+2i 'real) 
1 



2)) 
4)) 



(defclass complex-number () 
((rho : initarg :rho) 
(theta :theta))) 

> (slot-value l+2i 'real) 



; Redefine (polar) complex-number 



;The slot 'real' is gone 



The slot REAL is missing in the object #<COMPLEX-NUMBER @ #x717705a2> 

> (slot-value l+2i 'rho) ;The slot 'rho' is unbound 

The slot RHO is unbound in the object #<COMPLEX-NUMBER @ #x717705a2> 
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Redefinição da Classe de Instância 



(defmethod update-instance-f or-redef ined-class :before 
((c complex-number) 
added-slots 
discarded-slots 

property-list ; (real 3 imag 4) 

fere st args 
&key ftallow-other-keys) 



msm 



oãm 



■aaiBiiKUStH 



Redefinição da Classe de Instância 



(defmethod update-instance-f or-redef ined-class :before 
((c complex-number) 
added-slots 
discarded-slots 

property-list ; (real 3 imag 4) 

fere st args 

&key &allow-other-keys) 
(let ((r (getf property-list 'real)) 
(i (getf property-list 'imag))) 
(setf (slot-value c 'rho) 

(sqrt (+ (* r r) (* i i))) 
(slot-value c 'theta) 
(atan i r)))) 
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Redefinição da Classe de Instância 



(defmethod update-instance-f or-redef ined-class :before 
((c complex-number) 
added-slots 
discarded-slots 

property-list ; (real 3 imag 4) 

fere st args 

&key &allow-other-keys) 
(let ((r (getf property-list 'real)) 
(i (getf property-list 'imag))) 
(setf (slot-value c 'rho) 

(sqrt (+ (* r r) (* i i))) 
(slot-value c 'theta) 
(atan i r)))) 

> (slot-value l+2i 'rho) ;Too late for the first instance 
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Redefinição da Classe de Instância 



(defmethod update-instance-for-redef ined-class :before 
((c complex-number) 
added-slots 
discarded-slots 

property-list ; (real 3 imag 4) 

fere st args 

&key &allow-other-keys) 
(let ((r (getf property-list 'real)) 
(i (getf property-list 'imag))) 
(setf (slot-value c 'rho) 

(sqrt (+ (* r r) (* i i))) 
(slot-value c 'theta) 
(atan i r)))) 

> (slot-value l+2i 'rho) ;Too late for the first instance 

The slot RHO is unbound in the object #<COMPLEX-NUMBER @ #x717705a2> 
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Redefinição da Classe de Instância 



(defmethod update-instance-for-redef ined-class :before 
((c complex-number) 
added-slots 
discarded-slots 

property-list ; (real 3 imag 4) 

fere st args 

&key &allow-other-keys) 
(let ((r (getf property-list 'real)) 
(i (getf property-list 'imag))) 
(setf (slot-value c 'rho) 

(sqrt (+ (* r r) (* i i))) 
(slot-value c 'theta) 
(atan i r)))) 

> (slot-value l+2i 'rho) ;Too late for the first instance 

The slot RHO is unbound in the object #<COMPLEX-NUMBER @ #x717705a2> 

> (slot-value 3+4i 'rho) ;But on time for the second one 
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Redefinição da Classe de Instância 



(defmethod update-instance-for-redef ined-class :before 
((c complex-number) 
added-slots 
discarded-slots 

property-list ; (real 3 imag 4) 

fere st args 

&key &allow-other-keys) 
(let ((r (getf property-list 'real)) 
(i (getf property-list 'imag))) 
(setf (slot-value c 'rho) 

(sqrt (+ (* r r) (* i i))) 
(slot-value c 'theta) 
(atan i r)))) 

> (slot-value l+2i 'rho) ;Too late for the first instance 

The slot RHO is unbound in the object #<COMPLEX-NUMBER @ #x717705a2> 

> (slot-value 3+4i 'rho) ;But on time for the second one 
5.0 
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Exemplo hipotético: Acesso a um slot 



» Uma instância é representada por um array. 

• primeiro elemento do array é a classe a que a instância 
pertence. 

• Os restantes elementos do array são os valores dos slots. 



A função slot-value 



(defun slot-value (instance slot-name) 
(let ((class (aref instance 0))) 
(let ((slots (class-slots class))) 
(aref instance 

(1+ (position slot-name slots)))))) 



Problema 



Inflexível: uma única representação de instância 
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Exemplo hipotético: Acesso a um slot 



• A solução consiste em delegar a interpretação do acesso a um slot 
noutra entidade. 

• Uma possibilidade: usar a classe da classe da instância (i.e., a 
metaclasse da instância). 

• A metaclasse intermedeia o acesso à instância. 



A função slot-value 



(defun slot-value (instance slot-name) 

(slot-value-using-class (class-of instance) 

instance 
slot-name)) 
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Exemplo hipotético: Acesso a um slot 



• Para a metaclass de omissão (por exemplo, default-class), uma 
instância é representada por um array. 



A função slot-value 



(defmethod slot-value-using-class ((class default-class) 

instance 
slot-name) 
(let ((slots (class-slots class))) 
(aref instance 

(1+ (position slot-name slots))))) 
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Exemplo hipotético: Acesso a um slot 



• Para outra metaclasse (por exemplo, hash-table-class), uma 
instância é representada por uma hash-table. 



A função slot-value 



(defmethod slot-value-using-class ((class hash-table-class) 

instance 
slot-name) 
(gethash instance slot-name)) 
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Exemplo real: Acesso a um slot 



• Para a metaclasse de omissão standard-class. 



A função slot-value 



(defun slot-value (object slot-name) 
(let* ((class (class-of object)) 

(slot-def inition (f ind-slot-def inition class slot-name))) 
(if (null slot-def inition) 

(slot-missing class object slot-name 'slot-value) 
(slot-value-using-class class object slot-def inition)) ) ) 



A função slot-value-using-clas 



(defmethod slot-value-using-class 
((class standard-class) 
(object standard-object) 

(slotd standard-ef f ective-slot-def inition) ) 
(if ... 

(slot-unbound class object (slot-def inition-name slotd)) 
...)) 



^nO 



